habe ein Makro geschrieben das sehr groß und unübersichtlich
ist. Frage: kann man das Makro modifizieren d.h. eine Schleife
einbauen?
Sub Makro3()
Application.ScreenUpdating = False
On Error Resume Next
Sheets("1").Select
If Cells(53, 25) <> "" Then Range("W53:W56").Copy
Sheets("Tabelle3").Select
Range("B14").Select
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Sheets("1").Select
If Cells(49, 25) <> "" Then Range("W49:W52").Copy
Sheets("Tabelle3").Select
Range("B13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Sheets("1").Select
If Cells(45, 25) <> "" Then Range("W45:W48").Copy
Sheets("Tabelle3").Select
Range("B12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Sheets("1").Select
If Cells(41, 25) <> "" Then Range("W41:W44").Copy
Sheets("Tabelle3").Select
Range("B11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Sheets("1").Select
If Cells(37, 25) <> "" Then Range("W37:W40").Copy
Sheets("Tabelle3").Select
Range("B10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Sheets("1").Select
If Cells(33, 25) <> "" Then Range("W33:W36").Copy
Sheets("Tabelle3").Select
Range("B9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Sheets("1").Select
If Cells(29, 25) <> "" Then Range("W29:W32").Copy
Sheets("Tabelle3").Select
Range("B8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Sheets("1").Select
If Cells(25, 25) <> "" Then Range("W25:W28").Copy
Sheets("Tabelle3").Select
Range("B7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Sheets("1").Select
If Cells(21, 25) <> "" Then Range("W21:W24").Copy
Sheets("Tabelle3").Select
Range("B6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Sheets("1").Select
If Cells(17, 20) <> "" Then Range("W17:W20").Copy
Sheets("Tabelle3").Select
Range("B5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Sheets("1").Select
If Cells(13, 16) <> "" Then Range("W13:W16").Copy
Sheets("Tabelle3").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
Range("B4:E14").NumberFormat = "0.00"
'Selection.NumberFormat = "0.00"
Application.ScreenUpdating = True
End Sub
Kann mir jemand helfe?
Vielen Dank.
Grüße