Code verkürzen

Bild

Betrifft: Code verkürzen
von: Silke
Geschrieben am: 24.11.2015 11:25:30

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

Bild

Betrifft: AW: Code verkürzen
von: Rudi Maintaire
Geschrieben am: 24.11.2015 11:44:15
Hallo,
ein Versuch:

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

Gruß
Rudi

Bild

Betrifft: AW: Code verkürzen
von: Silke
Geschrieben am: 24.11.2015 11:53:33
Hallo Rudi,
es funktioniert scho mal sehr gut. Leider kommt immerwieder die Meldung:
"Es befindet sich eine große Menge von Informationen in der Zwischenablage. Wollen Sie diese Informationen später in andere Programme einfügen?
'Klicken Sie auf "Ja".............
Klicken sie auf "Nein"...........
BUTTON( JA) ....BUTTON(NEIN).....BUTTON(Abbrechen)
Jetzt muss ich 12 mal auf Nein drücken.
KAnn man dieses Abschalten?
LG Silke

Bild

Betrifft: AW: Code verkürzen
von: Rudi Maintaire
Geschrieben am: 24.11.2015 11:55:31
Hallo,
jeweils vor .Close False

Application.cutcopymode=false
Gruß
Rudi

Bild

Betrifft: Dankeschön :-)
von: Simone
Geschrieben am: 24.11.2015 12:44:41
.

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Ermittlung gefilterter Daten in vers. Abschnitten"