Dobry den,
mam v jednom listu ve sloupci napsane adresy. Chtel bych z tohoto listu pomoci maker adresu zkopirovat do jineho listu na urcite misto, dalsi adresu do jineho listu na stejne urcene misto. Adresy jsou v jednom sloupci a vzdy maji 4 radky pak jeden radek volny a zase 4 radky adresy.
Mohl by mi stim nekdo pomoct?
Excel makra, kopirovani dat
Re: Excel makra, kopirovani dat
Sub vladr()
'
' Makro na vložení adresy
'
'
Range("A1:A4").Select
Selection.Copy
Sheets("List2").Select
ActiveSheet.Paste
Sheets("List1").Select
Range("A6:A9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("List3").Select
ActiveSheet.Paste
Sheets("List1").Select
Range("A11:A14").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("List4").Select
ActiveSheet.Paste
End Sub
A tak můžeš dál pokračovat. Vloží se ti to na aktivní buňku v listu. Můžeš si to změnit aby ti to dalo do určitých buňěk.
'
' Makro na vložení adresy
'
'
Range("A1:A4").Select
Selection.Copy
Sheets("List2").Select
ActiveSheet.Paste
Sheets("List1").Select
Range("A6:A9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("List3").Select
ActiveSheet.Paste
Sheets("List1").Select
Range("A11:A14").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("List4").Select
ActiveSheet.Paste
End Sub
A tak můžeš dál pokračovat. Vloží se ti to na aktivní buňku v listu. Můžeš si to změnit aby ti to dalo do určitých buňěk.
-
- Level 4.5
- Příspěvky: 1544
- Registrován: březen 11
- Bydliště: Drsná Vysočina :D
- Pohlaví:
- Stav:
Offline
Re: Excel makra, kopirovani dat
To smicrle:
tak za toto by Vás tu i jinde ukamenovali
Použil bych toto, jelikož toho nebylo moc napsáno tak si to budete muset doupravit
tak za toto by Vás tu i jinde ukamenovali
Použil bych toto, jelikož toho nebylo moc napsáno tak si to budete muset doupravit
Kód: Vybrat vše
Sub AddAdres()
Dim shAdresy As Worksheet
Dim iRowsOffset As Integer
Set shAdresy = Sheets("Adresy") 'list s adresama
iRowsOffset = 1 'pomocne pro offset dalsi adresy
'projdi listy sesitu
For Each sh In ThisWorkbook.Sheets
'pokud jsou rozdilne od listu shAdresy proved
If sh.Name <> shAdresy.Name Then
'vloz adresy od do ciloveho listu ("A5") z shAdresy ("A1")
sh.Cells(5, "A").Resize(4, 1).Value = shAdresy.Cells(1, "A").Resize(4, 1).Offset(iRowsOffset, 0).Value
'offset pro dalsi adresu
iRowsOffset = iRowsOffset + 5
End If
Next
End Sub
Naposledy upravil(a) cmuch dne 23 úno 2016 07:18, celkem upraveno 1 x.
Re: Excel makra, kopirovani dat
To cmuch:
Já bych se za toto mít ve vlastním souboru taky kamenoval. Ale šel jsem mu naproti cestou nejmenšího odporu. Si myslím že to moc nezná tak tomu jednoduchému kódu porozumí.
Já bych se za toto mít ve vlastním souboru taky kamenoval. Ale šel jsem mu naproti cestou nejmenšího odporu. Si myslím že to moc nezná tak tomu jednoduchému kódu porozumí.
Re: Excel makra, kopirovani dat
Dekuji oboum za odpovedi. Ano zacinam stim a tak me postourani v obou kodech jen prospeje. :)
-
- Mohlo by vás zajímat
- Odpovědi
- Zobrazení
- Poslední příspěvek
-
- 1
- 420
-
od Grimm
Zobrazit poslední příspěvek
12 bře 2024 21:43
-
- 3
- 1968
-
od Melvidor
Zobrazit poslední příspěvek
21 črc 2023 08:41
-
-
Obnoveni ztracenych fotek z telefonu pri kopirovani do pc
od Dizzy66 » 21 led 2024 17:08 » v Vše ostatní (sw) - 2
- 1156
-
od šulda
Zobrazit poslední příspěvek
23 úno 2024 07:12
-
-
-
Libre Office Calc - Divné chování při kopírování textu Příloha(y)
od EZumrova » 02 dub 2024 08:12 » v Kancelářské balíky - 14
- 2139
-
od kecalek
Zobrazit poslední příspěvek
05 dub 2024 19:11
-
-
- 16
- 6324
-
od mirekol
Zobrazit poslední příspěvek
20 říj 2023 08:31
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 4 hosti