Bestimmte Zellen aus mehreren Dateien auslesen...

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Bestimmte Zellen aus mehreren Dateien auslesen...
von: TomTom
Geschrieben am: 23.04.2015 08:35:21

Guten Morgen :)
Hab das gerade schon mal geschrieben, aber irgendwie tauchte es nicht in der List auf, also, auf ein neues :D
Folgendes Problem :
Ich möchte aus ca 250 Excel Dokumenten aus einem bestimmten Blatt ( Blattname immer der gleich ) Zellen kopieren und in eine neue Datei einfügen um diese Auszuwerten ( deshalb am besten auch immer mit dem Dateinamen woher die Zahlen kommen ).
Bestimmt hat der ein oder andere hier schon etwas ähnliches dass er bereitstellen könnte, würde mich freuen.
Vielen dank.

Bild

Betrifft: AW: Bestimmte Zellen aus mehreren Dateien auslesen...
von: fcs
Geschrieben am: 23.04.2015 18:48:28
Hallo TomTom,
eine Suche in der RECHERCHE hätte bestimmt was verwertbares zum Vorschein gebracht.
Nachfolgen ein Beispiel.
Gruß
Franz

Sub alle_Dateien_Verzeichnis()
    Dim dlg As FileDialog
    Dim StatusCalc&
    Dim varItem, Ext$, Datei$
    Dim wkbNeu As Workbook, wkbQuelle As Workbook
    Dim wksNeu As Worksheet, wksQuelle As Worksheet, LR&
    
    On Error GoTo Fehler
    
    'Makrobremsen lösen
    With Application
      .ScreenUpdating = False
      .EnableEvents = False
      StatusCalc = .Calculation
      .Calculation = xlCalculationManual
    End With
    
    Set dlg = Application.FileDialog(msoFileDialogFolderPicker) 'Verzeichnis wählen
    If dlg.Show = True Then
        'Neue Mappe Anlegen
        Set wkbNeu = Application.Workbooks.Add(Template:=xlWBATWorksheet)
        Set wksNeu = wkbNeu.Worksheets(1)
        
        With wksNeu
          'Spaltentitel
          .Cells(1, 1) = "Verzeichnis:"
          .Cells(3, 1) = "Dateiname"
          .Cells(3, 2) = "Wert 1"
          .Cells(3, 3) = "Wert 2"
          .Cells(3, 4) = "Wert 3"
          'ggf. noch Formate für Spalten vorgeben
        End With
        
        For Each varItem In dlg.SelectedItems 'Die Abfrage für den selektierten Eintrag
            Ext = "*.xls*" 'Dateiextension ggf. anpassen
            Datei = Dir(varItem & "\" & Ext)
            Do While Datei <> ""
                If LCase(Datei) = LCase(ThisWorkbook.Name) Then GoTo NextDatei
                Set wkbQuelle = Workbooks.Open(Filename:=varItem & "\" & Datei, _
                      ReadOnly:=True, UpdateLinks:=False)
                
'                Set wksQuelle = wkbQuelle.Worksheets(1) '1. Tabelle aus der gelesen wird
                Set wksQuelle = wkbQuelle.Sheets("Tabelle1") 'Tabelle aus der gelesen wird
                With wksNeu
                  LR = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 'letzte Zeile der Spalte+1
                  .Cells(LR, 1) = wkbQuelle.Name
                  'Werte aus Zellen auslesen
                  .Cells(LR, 2) = wksQuelle.Range("A1") 'hier hinten sind die Zielzellen
                  .Cells(LR, 3) = wksQuelle.Range("B2") '
                  .Cells(LR, 4) = wksQuelle.Range("B3") '
                  'u.s.w
                End With
                wkbQuelle.Close SaveChanges:=False
                Set wkbQuelle = Nothing
NextDatei:
                Datei = Dir() 'wählt die nächste Datei
            Loop
            wksNeu.Cells(1, 2) = varItem
        Next
        With wksNeu
          .Columns.AutoFit
        End With
    
    End If
Fehler:
    With Err
      Select Case .Number
        Case 0 'alles OK
        Case 1004
          If Not wkbQuelle Is Nothing Then wkbQuelle.Close SaveChanges:=False
          Resume NextDatei
        Case -2147221080 'Automatisierungsfehler
          If Not wkbQuelle Is Nothing Then wkbQuelle.Close SaveChanges:=False
          Resume NextDatei
        Case Else
          MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, vbOKOnly, "Fehler-Makro"
      End Select
    End With
    'Makrobremsen zurücksetzen
    With Application
      .ScreenUpdating = True
      .EnableEvents = True
      .Calculation = StatusCalc
    End With
End Sub


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Bestimmte Zellen aus mehreren Dateien auslesen..."