• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

Téma: Kopie a přidání řádku

Zaslal/a Ales21 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š

Zaslat odpověď >

---

Vovka(16.12.2015 13:42)#028722

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

marjankaj(16.12.2015 13:54)#028723

@Vovka
To je ako hrach na stenu hádzať. Ja jednoducho na takéto otázky nereagujem.citovat

AL(16.12.2015 14:13)#028725

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

Ales86(22.12.2015 10:44)#028777

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š

Příloha: 28777_wall.zip (12kB, staženo 17x)

citovat

AL(22.12.2015 11:42)#028780

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

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse