Code verkürzen

Hallo zusammen,
kann man diesen Code verkürzen?
UND alle Dateien bis auf "Zusammenfassung" schließen.

Sub Makro4()
' Makro4 Makro
Workbooks.Open Filename:="G:\Transfer\Allgemein\WE\Werbung\601.xls"
Columns("A:P").Select
Selection.Copy
Windows("Zusammenfassung.xlsb").Activate
Columns("A:A").Select
Sheets("601").Select
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks.Open Filename:="G:\Transfer\Allgemein\WE\Werbung\602.xls"
Columns("A:P").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Zusammenfassung.xlsb").Activate
Sheets("602").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks.Open Filename:="G:\Transfer\Allgemein\WE\Werbung\603.xls"
Columns("A:P").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Zusammenfassung.xlsb").Activate
Sheets("603").Select
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks.Open Filename:="G:\Transfer\Allgemein\WE\Werbung\604.xls"
Columns("A:C").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Lieferant"
Columns("A:P").Select
Selection.Copy
Windows("Zusammenfassung.xlsb").Activate
Sheets("604").Select
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks.Open Filename:="G:\Transfer\Allgemein\WE\Werbung\605.xls"
Columns("A:P").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Zusammenfassung.xlsb").Activate
Sheets("605").Select
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("606").Select
Workbooks.Open Filename:="G:\Transfer\Allgemein\WE\Werbung\606.xls"
Columns("A:P").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Zusammenfassung.xlsb").Activate
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("607").Select
Workbooks.Open Filename:="G:\Transfer\Allgemein\WE\Werbung\607.xls"
Columns("A:P").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Zusammenfassung.xlsb").Activate
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("608+609").Select
Workbooks.Open Filename:="G:\Transfer\Allgemein\WE\Werbung\608 + 609.xls"
Columns("A:P").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Zusammenfassung.xlsb").Activate
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("615").Select
Workbooks.Open Filename:="G:\Transfer\Allgemein\WE\Werbung\615.xls"
Columns("A:P").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Zusammenfassung.xlsb").Activate
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("618").Select
Workbooks.Open Filename:="G:\Transfer\Allgemein\WE\Werbung\618.xls"
Columns("A:P").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Zusammenfassung.xlsb").Activate
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("621").Select
Workbooks.Open Filename:="G:\Transfer\Allgemein\WE\Werbung\621.xls"
Columns("A:P").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Zusammenfassung.xlsb").Activate
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("622").Select
Workbooks.Open Filename:="G:\Transfer\Allgemein\WE\Werbung\622.xls"
Columns("A:P").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Zusammenfassung.xlsb").Activate
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B44").Select
Sheets("Zusammenfassung").Select
Range("A1").Select
End Sub

Danke euch
LG Silke

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Code verkürzen

24.11.2015 11:44:15

Rudi

AW: Code verkürzen

24.11.2015 11:53:33

Silke

AW: Code verkürzen

24.11.2015 11:55:31

Rudi

Dankeschön :-)

24.11.2015 12:44:41

Simone

Sub Makro4() Dim i As Integer For i = 601 To 607 With Workbooks.Open(Filename:="G:\Transfer\Allgemein\WE\Werbung\" & i & ".xls") .Sheets(1).Columns("A:P").Copy Workbooks("Zusammenfassung.xlsb").Sheets(CStr(i)).Cells(1, 1).PasteSpecial _ Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False .Close False End With Next i For i = 615 To 621 Step 3 With Workbooks.Open(Filename:="G:\Transfer\Allgemein\WE\Werbung\" & i & ".xls") .Sheets(1).Columns("A:P").Copy Workbooks("Zusammenfassung.xlsb").Sheets(CStr(i)).Cells(1, 1).PasteSpecial _ Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False .Close False End With Next i i = 622 With Workbooks.Open(Filename:="G:\Transfer\Allgemein\WE\Werbung\" & i & ".xls") .Sheets(1).Columns("A:P").Copy Workbooks("Zusammenfassung.xlsb").Sheets(CStr(i)).Cells(1, 1).PasteSpecial _ Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False .Close False End With With Workbooks.Open(Filename:="G:\Transfer\Allgemein\WE\Werbung\608 + 609.xls") .Sheets(1).Columns("A:P").Copy Workbooks("Zusammenfassung.xlsb").Sheets("608+609").Cells(1, 1).PasteSpecial _ Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False .Close False End With Sheets("Zusammenfassung").Select Range("A1").Select End Sub

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread