< návrat zpět

MS Excel


Téma: Zjednodušení makra rss

Zaslal/a icon 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

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

icon#009202
avatar

'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
icon#009203
avatar
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
icon#009205
avatar
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 Sub
citovat
icon icon#009206
Poki
a co to vubec nekopirovat, jen priradit hodnoty?
takto:
sheets("L5A").Range("B4:B16") = sheets("shift_1").Range("B4:B16").value citovat
icon#009207
avatar
Jasné. Aj tak sa dá. 1citovat
#009208
avatar
Super, o dost jednodušší než předtím.
Mockrát děkuji oběma za pomoc :-)citovat
icon#009209
avatar
Téma se může uzamknout, nějak jsem si nevšim kde je tahle funkce tak to raději napíšu 5citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Novinky

Formulář Faktura III

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

Aktivní diskuse

Excel-graf XY, změna osy X

AL • 17.9. 23:37

Excel-graf XY, změna osy X

Santauml • 17.9. 15:16

Výpočet úspěšnosti

AL • 17.9. 13:28

Výpočet úspěšnosti

zorry • 17.9. 13:10

Výpočet úspěšnosti

zorry • 17.9. 13:05

Excel-graf XY, změna osy X

AL • 17.9. 12:14

Excel-graf XY, změna osy X

Santauml • 17.9. 11:54