ThisWorkbook.Worksheets

Sub Mehrere_Dateien_auswaehlen()

 

 

Dim arrDateien As Variant

Dim wbQuelle As Workbook

Dim LetzteZeile As Long

Dim cntDatei As Long

Dim rngQuelle As Range

 

'Screenupdating und PopUps deaktivieren

Application.ScreenUpdating = False

Application.DisplayAlerts = False

 

'Benutzer Dateien ausw_hlen lassen

arrDateien = Application.GetOpenFilename(FileFilter:="Excel-Dateien (*.xls*),*.xls*", MultiSelect:=True)

 

'Wurde eine Datei ausgew_hlt?

If IsArray(arrDateien) Then

 

    'Schleife Ùber alle ausgew_hlten Dateien

    For cntDatei = 1 To UBound(arrDateien)

     

        LetzteZeile = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row

         

        'Aktuelle Arbeitsmappe _ffnen

        Set wbQuelle = Workbooks.Open(Filename:=arrDateien(cntDatei))

         

        'Daten-Range setzen

        Set rngQuelle = wbQuelle.Worksheets(1).Range("B2").CurrentRegion

         

        'Daten kopieren und einfÙgen

        Intersect(rngQuelle, rngQuelle.Offset(1, 0)).Copy

        ThisWorkbook.Worksheets(1).Range("A" & LetzteZeile + 1).PasteSpecial

         

        'Arbeitsmappe schlie¤en

        wbQuelle.Close SaveChanges:=False

    Next cntDatei

 

End If