AW: Hilfe bei VBA Formel
29.06.2018 12:35:07
Torsten
Hallo Rakesh,
sorry, hat etwas gedauert. Hab dir mal was zusammengebastelt. Kommentare habe ich gemacht, wo du was anpassen musst.
Sub Daten_kopieren()
Dim Pfad As String, Dateiname As String, QSheet As String, ZSheet As String
Dim myRow As Long, myLastRow1 As Long, myLastRow2 As Long
QSheet = "Sheet1" 'hier den Namen des Sheets aus der Quelldatei eintragen, sollte _
immer gleich sein
ZSheet = "Sheet3" 'hier Name des Sheets in dieser Datei eintragen
Application.ScreenUpdating = False
Pfad = "Dein Pfad\" 'gib hier deinen Ordner Pfad an, wo die Dateien _
liegen
Dateiname = Dir(Pfad & "*.xlsx") 'hier musst du anpassen, ob es xlsx, xls, xlsm _
Dateien sind. Sollten alle gleich sein
Do While Dateiname ""
Workbooks.Open Filename:=Pfad & Dateiname
With ActiveWorkbook.Sheets(QSheet)
myLastRow1 = .Cells(Rows.Count, 1).End(xlUp).Row
End With
For myRow = myLastRow1 To 2 Step -1
If ActiveWorkbook.Sheets(QSheet).Cells(myRow, 1).Value "" Then
With ThisWorkbook.Sheets(ZSheet)
myLastRow2 = .Cells(Rows.Count, 1).End(xlUp).Row
End With
ActiveWorkbook.Sheets(QSheet).Rows(myRow).copy Destination:=ThisWorkbook.Sheets( _
ZSheet).Rows(myLastRow2 + 1)
End If
Next myRow
ActiveWorkbook.Close False
Dateiname = Dir()
Loop
Application.ScreenUpdating = True
End Sub
Lass mich wissen, ob alles klappt oder du noch Hilfe brauchst.
Gruss Torsten