MAKRO - sehrání více listů do jednoho - proměnná data

[MishaCZ]

MAKRO POMOC.xlsm

(20 KiB) Staženo 33 x

Dobrý den,
Makra se teprve učím ovládat a tak bych prosil o pomoc při vytvoření makra, které mi do jednoho listu dokáže pod sebe nakopírovat data ze 4 různých listu a to tak, že v těchto listech jsou proměnná data (např. někdy jsou zde data od řádku 3 po řádek 30, další den zde můžou být data od řádku 3 do řádku 150.). Jakési makro jsem si vytvořil, ale pokud zůstane jeden list prázdný (což je v tomto případě dost pravděpodobné, že nebudou vždy vyplněny všechny 4 listy) tak mi makro smaže pevně zadané data v základní obrazovce (protože makro pracuje tak, že vleze do listu a označí data PG DN and PG RIGHT - to když je prázdné tak prázdné překopíruju do sběrné tabulky do listu 1 a tam přemaže pevně daná data. Pokud na listech 2,3,4,5 udělám jakoukoliv změnu v počtu řádků, tak makro již nepracuje správně. Nevím jak zajistit, aby se podařilo vkládat jednotlivé listy pod sebe, aniž by se v makru neukázalo přesné umístění buňky (to je proměnné v závislosti na tom, kolik dat bude v těch ostatních listech.

zda je náhled makra, které jsem vytvořil. Předpokládám, že toto jde sepsat mnohem úhledněji.

Sub Makro2()
'
' Makro2 Makro
'

'
Range("A2").Select
Sheets("List2").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("List1").Select
ActiveSheet.Paste
Range("A2").Select
Selection.End(xlDown).Select
Range("A6").Select
Sheets("List3").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("List1").Select
ActiveSheet.Paste
Selection.End(xlToLeft).Select
Selection.End(xlDown).Select
Range("A10").Select
Sheets("List4").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("List1").Select
ActiveSheet.Paste
Selection.End(xlToLeft).Select
Selection.End(xlDown).Select
Range("A14").Select
Sheets("List5").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("List1").Select
ActiveSheet.Paste
Range("E2").Select
Application.CutCopyMode = False
Selection.Copy
Range("D2").Select
Selection.End(xlDown).Select
Range("E17").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub


V příloze přikládám celý soubor, pro lepší představu.
Předem moc děkuji za jakoukoliv pomoc.

S pozdravem
Michal

[Reklama]

[cmuch]

Dobrý den, pomůže třeba toto
http://www.pc-help.cz/viewtopic.php?t=105571&p=802526#p802526