etiket yapma makrosu

[byysmn]

arkadaşlar kolay gelsin
6 satırlı 3 sütunlu 18 li etiket makrosu yapmak istiyorum ama makro çok uzun oldu kısaltabilirmiyiz

Sub etiket()
'
' etiket Makro
'

'
Sheets("ETİKET LİSTE").Select
Range("M2:M4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ETİKET").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("ETİKET LİSTE").Select
Range("M5:M7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ETİKET").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("ETİKET LİSTE").Select
Range("M8:M10").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ETİKET").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("ETİKET LİSTE").Select
Range("M11:M13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ETİKET").Select
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("ETİKET LİSTE").Select
Range("M12:M14").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ETİKET").Select
Range("A5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("ETİKET LİSTE").Select
Range("M15:M17").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ETİKET").Select
Range("A6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("ETİKET LİSTE").Select
Range("M18:M20").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ETİKET").Select
Range("A7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("ETİKET LİSTE").Select
Range("M21:M23").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ETİKET").Select
Range("A8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("ETİKET LİSTE").Select
Range("M24:M26").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ETİKET").Select
Range("d1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("ETİKET LİSTE").Select
Range("M27:M29").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ETİKET").Select
Range("d2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("ETİKET LİSTE").Select
Range("M30:M32").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ETİKET").Select
Range("d3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("ETİKET LİSTE").Select
Range("M33:M35").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ETİKET").Select
Range("d4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("ETİKET LİSTE").Select
Range("M36:M38").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ETİKET").Select
Range("d5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("ETİKET LİSTE").Select
Range("M39:M41").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ETİKET").Select
Range("d6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("ETİKET LİSTE").Select
Range("M42:M44").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ETİKET").Select
Range("d7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("ETİKET LİSTE").Select
Range("M45:M47").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ETİKET").Select
Range("d8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End Sub

 

[Ömer]

Merhaba,

Örnek bir link, işinize yarayabilir.

http://www.excel.web.tr/f14/etiket-baskysy-icin-listeyi-yazdyrmak-t103699.html

.