VBA Code Modifikation

Sub DateienZusammenstellen() Dim strOrdner As String Dim strDatei As String Dim lngZeile As Long With Tabelle1 'folgender Befehl bereinigt die Tabelle (bis 500 Zeilen) (ab Zeile 4) .Range("B4:Y500").ClearContents lngZeile = 4 'Datei Auswertung Multi-Projekt Report liegt im gleichen Ordner wie die Berichte strOrdner = ThisWorkbook.Path 'Es werden alle Dateien mit der Datei-Endung xlsm verarbeitet strDatei = Dir(strOrdner & "\*.xlsm") 'Schleife: Es werden alle Dateien Dateien im Ordner gelistet Do While strDatei > "" .Cells(lngZeile, 2).Value = strDatei lngZeile = lngZeile + 1 strDatei = Dir Loop End With End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Guten Morgen Ralf,
das Problem dabei ist, dass ich mit VBA eigentlich nix am Hut habe. Ich habe die letzten Tage abendfüllend, Fachbücher, Foren und Youtube-Step-by-Step Videos verschlungen und bin trotzdem nicht auf eine grünen Zweig gekommen. Wahrscheinlich habe ich die falschen Fragen gestellt. Für definierte Quellen (Dateien) mit nur einem Tabellenblatt habe ich ne Menge gefunden und das hat auch meist geklappt - für dynamische Quellen, mit mehreren Tabellenblättern und zum Auslesen aus einem bestimmten Tabellenblatt wurde es dünn - habe mich trotzdem versucht und folgendes ist dabei raus gekommen:

Sub StatusAuslesen()
Dim strOrdner As String
Dim lngZeile As Long, lngZeileMax As Long
Dim lngZMax As Long, IngZeileFrei As Long
Dim wkbQuelle As Workbooks
With Tabelle1
    'Datei Auswertung Multi-Projekt Report liegt im gleichen Ordner wie die Berichte
    strOrdner = ThisWorkbook.Path
    'erste Bearbeitungszeile
    lngZeile = 4
    'Zählen der Zeilen von letzter Zeile zu Zeile 4 um die Anzahl der Schleifen zu bestimmen
    lngZeileMax = .Cells(.Rows.Count, 1).End(xlUp).Row
    
    For lngZeile = 4 To lngZeileMax
    
    'Excel Quelle öffnen -> String Quellordner + Dateiname aus Spalte A
    Set wbkQuelle = Workbooks.Open(strOrdner & "\" & .Cells(lngZeile, 1).Value)
    '.Cells(lngZeile, 2).Value =
    
        With Worksheets("Multi")
        
    
            lngZMax = .Cells(.Rows.Count, 1).End(xlUp).Row
            lngZeileFrei = Tabelle1.Cells(Tabelle1.Rows.Count, 1).End(xlUp).Row + 1
            .Range(.Cells(3, 1), .Cells(lngZMax, 29)).Copy
            Destination:=Worksheets(1).Cells(lngZeileFrei, 1)
        
        End With
        wbkQuelle.Close savechanges:=False
    
    Next lngZeile
End With

In nachfolgender Zeile schmiert mir die Sache mit der Meldung "Syntaxfehler" ab...

Destination:=Worksheets(1).Cells(lngZeileFrei, 1)

Für nen Schubs wäre ich dankbar...

Gruß Sebastian

Option Explicit Sub StatusAuslesen() Dim strOrdner As String Dim lngZeile As Long, lngZeileMax As Long, lngZ as long Dim lngZMax As Long, lngZeileFrei As Long Dim wkbQuelle As Workbook, wkbZiel As Workbook, wshZiel As Worksheet Set wkbZiel = ThisWorkbook Set wshZiel = wkbZiel.Sheets("Tabelle1") 'Datei Auswertung Multi-Projekt Report liegt im gleichen Ordner wie die Berichte strOrdner = wkbZiel.Path 'erste Bearbeitungszeile lngZeile = 4 With wshZiel 'Zählen der Zeilen von letzter Zeile zu Zeile 4 um die Anzahl der Schleifen zu bestimmen lngZeileMax = .Cells(.Rows.Count, 1).End(xlUp).Row End With For lngZ = lngZeile To lngZeileMax 'Excel Quelle öffnen -> String Quellordner + Dateiname aus Spalte A Set wkbQuelle = Workbooks.Open(strOrdner & "\" & wshZiel.Cells(lngZeile, 1).Value) '.Cells(lngZeile, 2).Value = With wkbQuelle.Worksheets("Multi") lngZMax = .Cells(.Rows.Count, 1).End(xlUp).Row lngZeileFrei = wshZiel.Cells(wshZiel.Rows.Count, 1).End(xlUp).Row + 1 .Range(.Cells(3, 1), .Cells(lngZMax, 29)).Copy _ Destination:=wshZiel.Cells(lngZeileFrei, 1) End With wkbQuelle.Close savechanges:=False Next lngZ End Sub

Sub StatusAuslesen() Dim Z As Range With ThisWorkbook.Sheets("Tabelle1") For Each Z In Intersect(.Range("A4:A999999"), .UsedRange) With Workbooks.Open(ThisWorkbook.Path & "\" & Z.Value) .Worksheets("Multi").Range("A2:AA2").Copy Z.Offset(0, 1).PasteSpecial xlValue .Close savechanges:=False End With Next End With End Sub

Hallo Sebastian,
in deiner Frage war nicht die Rede von A2:A26 sondern von A2:AA2.
Wenn Du eines vorab verstehen muss, bevor Du in die Welt der Programmiererei eintauchen möchtest: Computer lesen keine Gedanken (und ich auch nicht). Hier wird Genauigkeit erwartet.
Schau dir den Code an, lese den Code, auf Deutsch und laut. Dann wirst du merken, dass es kein Hexenwerk ist. Wenn Du etwas nicht kennst, wie z.B. .Copy, lege den Cursor drauf und Druck Strg+F1. Lese die Online-Hilfe (am Anfang genau. Irgendwann kannst du dir erlauben, es weiter zu lesen) und schau dir die Beispiel genau an.
Ich habe Verständnis, dass Du noch nicht so weit bist. Geholfen wird es dir, keine Frage. Aber Du musst dir selbst so weit bringen, dass Du mit deinem minimalistischen Code-Schnipsel zurecht finden kannst. Sonst können wir nicht weiter.
Ich hoffe, mein freundliche Anstupser war dir nicht zu heftig ;-)
VG
Yal

Beliebteste Forumthreads (12 Monate)

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread