MS Excel

Téma: Zjednodušení makra

Zaslal/a dytas 8.8.2012 9:10

Ahoj,

vytvořil jsem si makro pro kopírování dat z jednotlivých oblastí jednoho sheetu do dalších oblastí jiného sheetu ve stejném souboru (zdrojový sheet je z důvodu bezpečnosti schován). Nedalo by se to napsat i trochu jinak? Třeba jednodušeji? Jsem v makrech začátečník takže si s cykly ještě nevím rady ...

Sub LoadShift1()
Application.ScreenUpdating = False
sheets("shift_1").Visible = True
'L5A assy
sheets("shift_1").Select
Range("B4:B16").Select
Selection.Copy
sheets("L5A").Select
Range("B4:B16").Select
Selection.PasteSpecial Paste:=xlPasteValues
'L5A pack
sheets("shift_1").Select
Range("B20:B34").Select
Selection.Copy
sheets("L5A").Select
Range("B20:B34").Select
Selection.PasteSpecial Paste:=xlPasteValues
'L5B assy
sheets("shift_1").Select
Range("E4:E16").Select
Selection.Copy
sheets("L5B").Select
Range("B4:B16").Select
Selection.PasteSpecial Paste:=xlPasteValues
'L5B pack
sheets("shift_1").Select
Range("E20:E34").Select
Selection.Copy
sheets("L5B").Select
Range("B20:B34").Select
Selection.PasteSpecial Paste:=xlPasteValues
'L5C assy
sheets("shift_1").Select
Range("H4:H16").Select
Selection.Copy
sheets("L5C").Select
Range("B4:B16").Select
Selection.PasteSpecial Paste:=xlPasteValues
'L5C pack
sheets("shift_1").Select
Range("H20:H34").Select
Selection.Copy
sheets("L5C").Select
Range("B20:B34").Select
Selection.PasteSpecial Paste:=xlPasteValues
'L6A assy
sheets("shift_1").Select
Range("K4:K16").Select
Selection.Copy
sheets("L6A").Select
Range("B4:B16").Select
Selection.PasteSpecial Paste:=xlPasteValues
'L6A pack
sheets("shift_1").Select
Range("K20:K34").Select
Selection.Copy
sheets("L6A").Select
Range("B20:B34").Select
Selection.PasteSpecial Paste:=xlPasteValues
'L6C assy
sheets("shift_1").Select
Range("N4:N16").Select
Selection.Copy
sheets("L6C").Select
Range("B4:B16").Select
Selection.PasteSpecial Paste:=xlPasteValues
'L6C pack
sheets("shift_1").Select
Range("N20:N34").Select
Selection.Copy
sheets("L6C").Select
Range("B20:B34").Select
Selection.PasteSpecial Paste:=xlPasteValues
'L7A assy
sheets("shift_1").Select
Range("Q4:Q16").Select
Selection.Copy
sheets("L7A").Select
Range("B4:B16").Select
Selection.PasteSpecial Paste:=xlPasteValues
'L7A pack
sheets("shift_1").Select
Range("Q20:Q34").Select
Selection.Copy
sheets("L7A").Select
Range("B20:B34").Select
Selection.PasteSpecial Paste:=xlPasteValues
'L7D assy
sheets("shift_1").Select
Range("T4:T17").Select
Selection.Copy
sheets("L7D").Select
Range("B4:B17").Select
Selection.PasteSpecial Paste:=xlPasteValues
'others
sheets("shift_1").Select
Range("W4:W14").Select
Selection.Copy
sheets("Others").Select
Range("B4:B14").Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
sheets("Summary").Select
sheets("shift_1").Visible = False
End Sub

Uzamčeno - nelze přidávat nové příspěvky.

marjankaj(8.8.2012 10:40)#009202

'L5A assy
sheets("shift_1").Select
Range("B4:B16").Select
Selection.Copy
sheets("L5A").Select
Range("B4:B16").Select
Selection.PasteSpecial Paste:=xlPasteValues
Toto nahraď takto. Skopíruje ti to aj vzorce.

'L5A assy
sheets("shift_1").Range("B4:B16").Copy sheets("L5A").Range("B4:B16")citovat

dytas(8.8.2012 10:50)#009203

To je právě to co nechci - zkopírovat i vzorce, potřebuji aby se mi zkopírovali pouze hodnoty, ve zdrojovém sheetu jsou totiž vzorce, které se odkazují na další soubory takže to PasteValues tam je schválně ...
Nedal by se obecně ten cyklus nějak definovat pomocí proměnných a ty pak nastavovat?citovat

marjankaj(8.8.2012 11:28)#009205

Tak potom takto.

Sub Makro1()
a = Array("B4:B16", "B20:B34") ' doplň si to do konca
b = Array("L5A", "L5A") ' aj tu si to doplň, počet musí byť rovnaký.

For i = LBound(a) To UBound(a)
Sheets("shift_1").Range(a(i)).Copy
Sheets(b(i)).Range(a(i)).PasteSpecial Paste:=xlPasteValues
Next i
Application.CutCopyMode = False
End Subcitovat