Microsoft Excel

Herbers Excel/VBA-Archiv

Datenimport aus mehreren Arbeitsmappe

Betrifft: Datenimport aus mehreren Arbeitsmappe von: Firat
Geschrieben am: 30.09.2020 14:25:20

Guten Tag liebe Excel Freunde.
Ich benötige einmal eure Hilfe.

Ich habe in dem Ordner Customer mehrere unterordner in denen sich mehrere Dateien befinden.
Unterordnerbezeichnung: 01January, 02February, ..., 12December
Dateiname: Dispatch_customer_*
*Datum = Format (YYYY-MM-DD)

Der Ordner Customer befindet sich auf meinem Desktop.

Ich würde gerne aus allen existierenden Dateien die Daten von A3:T(n) in eine neues Arbeitsblatt eintragen lassen, sodass ich nicht jedes Einzelne Arbeitsblatt durchgehen muss.

n= letzte Zeile mit Daten

Es wäre super, wenn ihr mir helfen könntet.
Sollte ich etwas vergessen haben, damit meine Frage beantwortet werden kann, bitte ich um eine kurze Rückmeldung.

Mfg
Firat

Betrifft: AW: Datenimport aus mehreren Arbeitsmappe
von: Nepumuk
Geschrieben am: 30.09.2020 14:59:05

Hallo Firat,

teste mal:

Option Explicit

Public Sub Import_Dispatch_customer()
    
    Dim strFolder As String, astrFolders() As String
    Dim strFileName As String
    Dim ialngFolders As Long, lngRow As Long
    Dim objWorksheet As Worksheet, objWorkbook As Workbook
    
    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    lngRow = 1
    
    strFolder = Environ$("USERPROFILE") & "\Desktop\Customer\"
    
    astrFolders = GetFolders(strFolder)
    
    Set objWorksheet = ThisWorkbook.Worksheets.Add(Before:=ThisWorkbook.Sheets(1))
    
    For ialngFolders = LBound(astrFolders) To UBound(astrFolders)
        
        strFileName = Dir$(astrFolders(ialngFolders) & "Dispatch_customer_*.xls*")
        
        Do Until strFileName = vbNullString
            
            Set objWorkbook = Workbooks.Open(Filename:=astrFolders(ialngFolders) & strFileName)
            
            With objWorkbook.Worksheets(1)
                Call .Range(.Cells(3, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 20)).Copy( _
                    Destination:=objWorksheet.Cells(lngRow, 1))
            End With
            
            Call objWorkbook.Close(SaveChanges:=False)
            
            With objWorksheet
                lngRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            End With
            
            strFileName = Dir$
            
        Loop
    Next
    With Application
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Private Function GetFolders(ByVal pvstrPath As String) As String()
    Dim astrFolders() As String
    Dim strFolder As String, strPath As String
    Dim ialngIndex1 As Long, ialngIndex2 As Long
    Redim Preserve astrFolders(ialngIndex1)
    astrFolders(ialngIndex1) = pvstrPath
    ialngIndex1 = 1
    ialngIndex2 = 1
    strPath = pvstrPath
    Do
        strFolder = Dir$(PathName:=strPath & "*", Attributes:=vbDirectory)
        Do Until strFolder = vbNullString
            If strFolder <> "." And strFolder <> ".." Then
                If GetAttr(PathName:=strPath & strFolder) And vbDirectory Then
                    Redim Preserve astrFolders(0 To ialngIndex1)
                    astrFolders(ialngIndex1) = strPath & strFolder & "\"
                    ialngIndex1 = ialngIndex1 + 1
                End If
            End If
            strFolder = Dir$
        Loop
        If ialngIndex1 = ialngIndex2 Then Exit Do
        strPath = astrFolders(ialngIndex2)
        ialngIndex2 = ialngIndex2 + 1
    Loop
    GetFolders = astrFolders
End Function

Gruß
Nepumuk

Betrifft: AW: Datenimport aus mehreren Arbeitsmappe
von: Okan Firat
Geschrieben am: 02.10.2020 13:20:55

Hi Nepumuk,



danke für die schnelle Rückmeldung und entschuldige bitte, dass ich so lange gebraucht habe.



Leider funktioniert der Code nicht.



Ich habe darauf geachtet, dass USERPROFIL = mein Profilname ist, wie auch ob die Ordnerbezeichnungen oder die Dateibezeichnungen abweichen.



Leider habe ich den Fehler nicht gefunden.







Ich habe eine leere Arbeitsmappe geöffnet und das makro laufen lassen.



Das einzige was passiert ist, dass ein neues Tabellenblatt erzeugt wird.



Leider sind alle Tabellenblätter leer.







Auch habe ich gemerkt, dass ich bei meiner ersten Anfrage vergessen habe zu erwähnen, dass nicht unbedingt Daten in der Zelle T(n) erhalten sind.



Es müsste ermittelt werden, welches die letzte zeite in Spalte A ist und diese Zeilennummer müsste dann für Spalte T geltenn.







Ich hoffe, dass du mir da weiterhelfen kannst.



Ich bedanke mich im Voraus.







MfG



Firat

Betrifft: AW: Datenimport aus mehreren Arbeitsmappe
von: Nepumuk
Geschrieben am: 02.10.2020 13:40:48

Hallo Firat,

Environ$("USERPROFILE") enthält deinen Anmeldename.

Bei mir ist das:

C:\Users\Gepard

Wobei Gepard mein Anmeldename in Windows ist.

Es wird der letzte Eintrag in Spalte A berücksichtigt.

Gruß
Nepumuk

Betrifft: AW: Datenimport aus mehreren Arbeitsmappe
von: Günther
Geschrieben am: 30.09.2020 19:01:02

Moin,
das sollte sich mit Power Query (Daten | Abrufen und transformieren) lösen lassen. Zum Einstieg (Import der Daten) kann das hier helfen: http://www.excel-ist-sexy.de/alle-xlsx-eines-ordners-importieren/
 
Gruß
Günther  |  mein Excel-Blog

Betrifft: AW: Datenimport aus mehreren Arbeitsmappe
von: Okan Firat
Geschrieben am: 02.10.2020 13:23:50

Guten Tag Günter,
auch dir danke ich für die schnelle Rückmeldung.
Ich werde mir die PowerQuerry Funktion von excel mal heute anschauen und hoffe, dass ich damit das Problem selbstständig lösen kann.

Mfg
Firat