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

Poki(8.8.2012 11:43)#009206

a co to vubec nekopirovat, jen priradit hodnoty?
takto:
sheets("L5A").Range("B4:B16") = sheets("shift_1").Range("B4:B16").value citovat

marjankaj(8.8.2012 11:55)#009207

Jasné. Aj tak sa dá.

citovat

Anonym(8.8.2012 14:42)#009208

Super, o dost jednodušší než předtím.
Mockrát děkuji oběma za pomoc :-)citovat

dytas(8.8.2012 14:46)#009209

Téma se může uzamknout, nějak jsem si nevšim kde je tahle funkce tak to raději napíšu

citovat

Uživatelské menu

Nejste přihlášen(a)

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.