Stránka 1 z 1
VBA - vykopírování dat
Napsal: 07 srp 2020 11:16
od Lůjík
Ahoj
byl by tu prosím někdo ochotný mi poradit? Potřebovala bych vykopírovat data z ruzných listů (seznam těchto listů je na listu settings, sloupec K) pod sebe. Někdy na těchto listech ale nejsou data, což by se asi dalo ošetřit takto:
If Range("A2") <> "" Then
Range ("A2" & Rows.Count.End(xlUp).Row.Select)
Sheets("NAVISYS").Select
pokud jsou, mají pokaždý jiný počet řádků a potřebovala bych je nakopírovat pod sebe na list NAVISYS... někdo ochotný mi poradit, moc prosím?
Re: VBA - vykopírování dat
Napsal: 07 srp 2020 11:57
od MePExG
To by išlo aj pomocou Power Query. Ak dáte súbor so skutočnou štruktúrou, tak Vám to môžem pripraviť.
Re: VBA - vykopírování dat
Napsal: 07 srp 2020 12:07
od Lůjík
Děkuji moc, ale bohužel jde o citlivá data o zaměstnancích :( Já jsem ve VBA začátečník, ale oc je prosím Power Query?
Re: VBA - vykopírování dat
Napsal: 07 srp 2020 14:12
od MePExG
PQ je doplnok od verzie 2010 a od v. 2016 je už súčasťou MSE. Stačí zachovať hlavičky a údaje 2-3 riadky vymyslené (aspoň dva listy) a vložiť ako prílohu pri úplnom editore.
Re: VBA - vykopírování dat
Napsal: 10 srp 2020 09:50
od Lůjík
Děkuju moc, vážím si každé pomocné ruky :) Ale přesto bych to chtěla přes klasické VBA - učím se v něm a tohle je na mě asi moc high-tech :) Zatím mám toto, jen potřebuji zakomponovat Loop... :
Sub End_of_month2()
'makro na vykopírování dat pro list NAVISYS
'Dim i As Integer
Sheets("settings").Select
Range("K1").Select
Sheets(Range("K1").Value).Select
If Range("A2") <> "" Then
Rows(2).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Else
End If
Sheets("NAVISYS").Select
Range("A" & Rows.Count).End(xlUp).EntireRow.Offset(1, 0).Select
ActiveSheet.Paste
Sheets("settings").Select
Sheets(ActiveCell.Offset(1, 0).Value).Select
'Loop
End Sub
Re: VBA - vykopírování dat
Napsal: 12 srp 2020 00:34
od elninoslov
Priložte nejakú prílohu, nech je jasnejšie, čo tým myslíte, a hlavne aké je rozloženie dát, či sú medzi riadkami dátových listov medzery, či môže nastať neexistencia listu, a treba chytať chyby a pod...
Zjednodušený príklad:
Kód: Vybrat vše
Sub End_of_month2() 'makro na vykopírování dat pro list NAVISYS
Dim RS As Long, arS()
Dim i As Long, RW As Long
'načítanie zoznamu listov
With wsSettings 'pracuj s listom Settings
RS = .Cells(Rows.Count, "K").End(xlUp).Row 'počet riadkov zoznamu listov (podľa popisu nieje hlavička)
If RS = 1 Then 'počet 1 dostaneme aj keď je 0 aj 1
ReDim arS(1 To 1, 1 To 1) 'jednoprvkové pole nemôžeme priradiť priamo, tak ho vytvoríme
arS(1, 1) = .Range("K1").Value 'a potom doň priradíme hodnotu
Else
arS() = .Range("K1:K" & RS).Value 'viacprvkové pole zaplníme rovno
End If
End With
'prechádzanie listov a kopírovanie hodnôt
For i = 1 To RS 'prejdeme všetky prvky poľa listov
If Not IsEmpty(arS(i, 1)) Then 'spracuj list iba ak je prvok poľa neprázdny (ošetrenie vynechania alebo žiadneho riadka)
With Worksheets(arS(i, 1)) 'pracuj s listom podľa indexu
RW = .Cells(Rows.Count, "A").End(xlUp).Row - 1 'počet riadkov v danom liste (nepredpokladá medzery medzi riadkami, a hlavička sa vynechá)
If RW > 0 Then 'ak sú v stĺpci A nejaké data
wsNAVISYS.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(RW).Value = .Cells(2, 1).Resize(RW).Value 'tak ich nakopíruj pod posledné data v stĺpci A v liste NAVISYS
End If
End With
End If
Next i
End Sub