821 Aufrufe
Gefragt in Tabellenkalkulation von
Hallo Zusammen,

ich habe folgendes Problem und leider wenig Ahnung von VBA.

Ich habe mehrere Dateien in einem Ordner, aus welchen ich bestimmte Zellen auslesen muss.

Bis dato hat das ein Kollege bei uns gemacht, welcher aber leider nicht mehr bei uns ist.

In der Vergangenheit hatte die auszulesende Datei nur ein Tabellenblatt. Heute kann sie auch ein zweites enthalten, welches dann ausgelesen werden muss und die Zellen in der "Zusammenfassungsdatei" in einen separaten Reiter kopiert werden mussen.

Die Daten sollten einfach untereinander geschrieben werden.

Hier das Makro was ich übernommen habe, ohne die Funktion ein mögliches zweites Tabellenblatt in der Quelldatei auszulesen:

Sub Auslesen()

    Dim cDir As String
    Dim sPath As String
    Dim Count As Integer
    Dim Filecount As Integer
    
    
    
    Dim quelldatei As Workbook
    Dim Zieldatei As Workbook
    
    
    sPath = Range("B7").Text
    cDir = Dir(sPath & "*.xlsx")
    
    
    
    
    Count = 2
    Filecount = 0
    
    
    
    Do While cDir <> ""
    
        Set quelldatei = Workbooks.Open(sPath & cDir)
        Filecount = Filecount + 1
        With quelldatei.Sheets(1)
            
            For i = 10 To 95
            If quelldatei.Sheets(1).Cells(i, 14) = "" Then
            
            Else
                 Tabelle1.Cells(Count, 1) = quelldatei.Sheets(1).Cells(4, 4)
                 Tabelle1.Cells(Count, 2) = quelldatei.Sheets(1).Cells(7, 4)
                 Tabelle1.Cells(Count, 3) = quelldatei.Sheets(1).Cells(i, 3)
                 Tabelle1.Cells(Count, 4) = quelldatei.Sheets(1).Cells(i, 4)
                 Tabelle1.Cells(Count, 5) = quelldatei.Sheets(1).Cells(i, 5)
                 Tabelle1.Cells(Count, 6) = quelldatei.Sheets(1).Cells(i, 6)
                 Tabelle1.Cells(Count, 7) = quelldatei.Sheets(1).Cells(i, 14)
                                  
                 
                 Count = Count + 1
            End If
            Next i
         End With
         
        ActiveWorkbook.Close False
        
        'nächste Datei lesen
       cDir = Dir
    Loop
    
    MsgBox (Filecount & " wurden eingelesen")
End Sub


Ich hoffe ihr könnt mir helfen, mein Chef sitzt mir im Nacken! :)

Vielen Dank im Voraus!

Gruß, David

6 Antworten

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo David,

ja, ja, immer diese Chefs ;-).

Probier mal den folgenden Code:
[code]Sub Auslesen()

Dim cDir As String
Dim sPath As String
Dim Count As Integer
Dim Filecount As Integer
Dim quelldatei As Workbook
Dim Anzahl As Long
Dim i As Long
Dim t As Long


sPath = Range("B7").Text
cDir = Dir(sPath & "*.xlsx")

Count = 2
Filecount = 0

Do While cDir <> ""

  Set quelldatei = Workbooks.Open(sPath & cDir)
  Filecount = Filecount + 1
  With quelldatei
   Anzahl = .Worksheets.Count  'Auslesen der Anzahl der Tabellen in der Quelldatei
   For t = 1 To Anzahl         'einzelne Arbeitsblätter durchlaufen
      With .Sheets(t)
           For i = 10 To 95
                 If .Cells(i, 14) <> "" Then
                        Tabelle1.Cells(Count, 1) = .Cells(4, 4)
                        Tabelle1.Cells(Count, 2) = .Cells(7, 4)
                        Tabelle1.Cells(Count, 3) = .Cells(i, 3)
                        Tabelle1.Cells(Count, 4) = .Cells(i, 4)
                        Tabelle1.Cells(Count, 5) = .Cells(i, 5)
                        Tabelle1.Cells(Count, 6) = .Cells(i, 6)
                        Tabelle1.Cells(Count, 7) = .Cells(i, 14)
                      Count = Count + 1
                 End If
           Next i
      End With
   Next t
  End With

ActiveWorkbook.Close False

'nächste Datei lesen
cDir = Dir
Loop

MsgBox (Filecount & " wurden eingelesen")
End Sub[/code]
Wie du siehst habe ich ihn etwas gekürzt, er sollte aber dennoch funktionieren.

Gruß
M.O.
0 Punkte
Beantwortet von
Hallo M.O.,

vielen Dank für deine schnelle Antwort.

Ich habe allerdings das Problem, dass die Zellen aus dem eventuellen 2. Reiter in der Zieldatei auch in einen separaten Reiter müssen.

Da die Namen der Reiter in der Quelldatei immer gleich sind hier deren Bezeichnungen:

Reiter 1: Planung
Reiter 2 (nicht immer vorhanden): Management

Vielen Dank im Voraus! :)

Beste Grüße, David
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo Daniel,

probiere mal den folgenden Code:
[code]Sub Auslesen()

Dim cDir As String
Dim sPath As String
Dim lngZeile As Long
Dim Filecount As Integer
Dim quelldatei As Workbook
Dim Anzahl As Long
Dim i As Long
Dim t As Long
Dim strZieltabelle As String

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

sPath = Range("B7").Text
cDir = Dir(sPath & "*.xlsx")

Filecount = 0

Do While cDir <> ""

  Set quelldatei = Workbooks.Open(sPath & cDir)
  Filecount = Filecount + 1
  With quelldatei
   Anzahl = .Worksheets.Count  'Auslesen der Anzahl der Tabellen in der Quelldatei
   For t = 1 To Anzahl         'einzelne Arbeitsblätter durchlaufen
      'Name des Arbeitsblatt festlegen, in das die Daten geschrieben werden sollen
      'Achtung! Es wird davon ausgegangen, dass maximal zwei Tabellenblätter in den zu öffnenden Datei vorhanden sind
      'und diese nur Planung und Management heißen
      If Sheets(t).Name = "Planung" Then
         'Name der Zieltabelle in der die Daten aus den Tabellenblättern Planung geschrieben werden sollen
         strZieltabelle = "ZusammenPlanung"
      Else
         'ansonsten werden die Daten in die Tabelle für die Managementdaten geschrieben
         strZieltabelle = "ZusammenManagement"
      End If
                  
      With .Sheets(t)
             'Einfügezeile = letzte beschriebene Zeile im betreffenden Tabellenblatt plus 1
              lngZeile = ThisWorkbook.Worksheets(strZieltabelle).Cells(Rows.Count, 1).End(xlUp).Row + 1
              
              For i = 10 To 95
                 If .Cells(i, 14) <> "" Then
                       ThisWorkbook.Worksheets(strZieltabelle).Cells(lngZeile, 1) = .Cells(4, 4)
                       ThisWorkbook.Worksheets(strZieltabelle).Cells(lngZeile, 2) = .Cells(7, 4)
                       ThisWorkbook.Worksheets(strZieltabelle).Cells(lngZeile, 3) = .Cells(i, 3)
                       ThisWorkbook.Worksheets(strZieltabelle).Cells(lngZeile, 4) = .Cells(i, 4)
                       ThisWorkbook.Worksheets(strZieltabelle).Cells(lngZeile, 5) = .Cells(i, 5)
                       ThisWorkbook.Worksheets(strZieltabelle).Cells(lngZeile, 6) = .Cells(i, 6)
                       ThisWorkbook.Worksheets(strZieltabelle).Cells(lngZeile, 7) = .Cells(i, 14)
                       lngZeile = lngZeile + 1
                 End If
           Next i
      End With
   Next t
  End With

ActiveWorkbook.Close False

'nächste Datei lesen
cDir = Dir
Loop

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

MsgBox (Filecount & " Dateien wurden eingelesen")
End Sub[/code]
Die Namen der Tabellenblätter, in die die Daten aus den Tabellenblättern Planung und Mangement hineinkopiert werden sollen, musst du natürlich noch anpassen.

Gruß

M.O.
0 Punkte
Beantwortet von
Hallo M.O.

wow, super! Das funktioniert!!! Besten Dank!! Du bist meine Rettung!!! :)

[quote]Es wird davon ausgegangen, dass maximal zwei Tabellenblätter in den zu öffnenden Datei vorhanden sind
      'und diese nur Planung und Management heißen
[/quote]

Nur Interesse halber, wie würde der Code aussehen, wenn ich drei oder mehrere Tabellenblätter in der Quelldatei habe, welche in drei Zielblätter kopiert werden sollen?

VG,
David
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo David,

dann musst du die folgende IF-Abfrage erweitern bzw. ändern:
 [code]If Sheets(t).Name = "Planung" Then
         'Name der Zieltabelle in der die Daten aus den Tabellenblättern Planung geschrieben werden sollen
         strZieltabelle = "ZusammenPlanung"
      Else
         'ansonsten werden die Daten in die Tabelle für die Managementdaten geschrieben
         strZieltabelle = "ZusammenManagement"
      End If[/code]
z.B. in
[code] If Sheets(t).Name = "Planung" Then  strZieltabelle = "ZusammenPlanung"
 If Sheets(t).Name = "Management" Then  strZieltabelle = "ZusammenManagement"
 If Sheets(t).Name = "Produktion" Then  strZieltabelle = "ZusammenProduktion" [/code]
Oder du benutzt statt den IF-Anweisungen Select Case:
[code]Select Case Sheets(t).Name
        Case Is = "Planung"
            strZieltabelle = "ZusammenPlanung"
        Case Is = "Management"
            strZieltabelle = "ZusammenManagement"
        Case Is = "Produktion"
            strZieltabelle = "ZusammenProduktion
End Select[/code]
Gruß
M.O.
0 Punkte
Beantwortet von
Super klasse!!!
Vielen herzlichen Dank für deine Unterstützung!

VG,
David
...