Nekonečný příběh: nepřesný popis problému lze zpravidla upřesnit ukázkou sešitu. Lidé, kteří se sem chodí ptát, se snad občas podívají jak se ptají ti druzí. Zjistili by, že dotaz s přílohou má nepoměrně vyšší šanci než dotaz bez ní.citovat
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: Kopie a přidání řádku
MS Excel
Téma: Kopie a přidání řádku 
Zaslal/a 16.12.2015 9:48
Dobrý den,
prosím o radu, řeším následující problém:
V jednom listu je uveden seznam kontaktů (na každém řádku 1), ke kontaktu jsou přiřazeny další údaje (email..). Každý kontakt má i položku "země". Potřeboval bych aby tento záznam (celý řádek) byl zkopírován a vložen jako nový do jiného listu (list se jménem země).
Děkuji Vám moc za radu
Aleš
@Vovka
To je ako hrach na stenu hádzať. Ja jednoducho na takéto otázky nereagujem.citovat
To je ako hrach na stenu hádzať. Ja jednoducho na takéto otázky nereagujem.citovat
Možnosti riešenia nájdeš tuná:http://www.rondebruin.nl/win/s3/win006.htm. Tento kód robí presne to, čo požaduješ: http://www.rondebruin.nl/win/s3/win006_4.htmcitovat
Dobrý den,
díky za radu i za odpovědi před ní.
V příloze přikládám vzorový soubor. V listu kontakty je seznam všech kontaktů. Tyto kontakty jsou dále zobrazovány v v jednotlivých listech dle jména země (zvýrazněno oranžově). V tomto souboru jsou pouze nakopírovány. Makro toto mělo zautomatizovat
Díky ještě jednou
Aleš
díky za radu i za odpovědi před ní.
V příloze přikládám vzorový soubor. V listu kontakty je seznam všech kontaktů. Tyto kontakty jsou dále zobrazovány v v jednotlivých listech dle jména země (zvýrazněno oranžově). V tomto souboru jsou pouze nakopírovány. Makro toto mělo zautomatizovat
Díky ještě jednou
Aleš
Příloha: 
28777_wall.zip (12kB, staženo 17x)
citovat28777_wall.zip (12kB, staženo 17x)Aha, takže tá "země" má byť vždy uvedená v nejakom inom stĺpci, t.j. neplatí, jeden kontakt=jedna země. V tom prípade skús toto, základ je funkčný, prípadnú optimalizáciu a ošetrenie chýb už nechám na tebe. Nabudúce vlož prílohu rovno, aby sa nemuselo tápať, čo vlastne potrebuješ, pôvodné zadanie som chápal trochu inak.Sub GenerujListy()
Dim srcSh As Worksheet, sh As Worksheet, srcRng As Range, cell As Range, tgtSh As Worksheet, tgtRng As Range
Set srcSh = Sheets("Kontakty")
For Each sh In Worksheets
Application.DisplayAlerts = False
If sh.Name <> srcSh.Name Then sh.Delete
Application.DisplayAlerts = True
Next sh
Set srcRng = [L1]
Set srcRng = Range(srcRng, srcRng.End(xlToRight))
For Each cell In srcRng
srcSh.Copy after:=Sheets(Sheets.Count)
Set tgtSh = ActiveSheet
With tgtSh
.Name = cell
Set tgtRng = .[A1].CurrentRegion
Set tgtRng = tgtRng.Offset(1, 0).Resize(tgtRng.Rows.Count, 1)
.[A1].AutoFilter FIELD:=cell.Column, Criteria1:="="
tgtRng.EntireRow.Delete
.[A1].AutoFilter
Set tgtRng = .[K1]
Set tgtRng = Range(tgtRng, tgtRng.End(xlToRight))
tgtRng.EntireColumn.Delete
Rows("1:1").Insert
.[A1] = "Kontakty"
Set tgtRng = .[A1:J1]
With tgtRng
.Font.Size = 14
.Font.Bold = True
.Interior.Color = 49407
End With
End With
Next cell
End Subcitovat
Dim srcSh As Worksheet, sh As Worksheet, srcRng As Range, cell As Range, tgtSh As Worksheet, tgtRng As Range
Set srcSh = Sheets("Kontakty")
For Each sh In Worksheets
Application.DisplayAlerts = False
If sh.Name <> srcSh.Name Then sh.Delete
Application.DisplayAlerts = True
Next sh
Set srcRng = [L1]
Set srcRng = Range(srcRng, srcRng.End(xlToRight))
For Each cell In srcRng
srcSh.Copy after:=Sheets(Sheets.Count)
Set tgtSh = ActiveSheet
With tgtSh
.Name = cell
Set tgtRng = .[A1].CurrentRegion
Set tgtRng = tgtRng.Offset(1, 0).Resize(tgtRng.Rows.Count, 1)
.[A1].AutoFilter FIELD:=cell.Column, Criteria1:="="
tgtRng.EntireRow.Delete
.[A1].AutoFilter
Set tgtRng = .[K1]
Set tgtRng = Range(tgtRng, tgtRng.End(xlToRight))
tgtRng.EntireColumn.Delete
Rows("1:1").Insert
.[A1] = "Kontakty"
Set tgtRng = .[A1:J1]
With tgtRng
.Font.Size = 14
.Font.Bold = True
.Interior.Color = 49407
End With
End With
Next cell
End Subcitovat
Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.
RSS nejnovější články