Zeile aus externen Datei einlesen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub t() Dim sPfad As String, sExt As String, sDatei As String Dim WB1 As Workbook, WB2 As Workbook Set WB1 = ThisWorkbook sPfad = Left(WB1.Path, InStrRev(WB1.Path, "\")) & "Ordner c\Ordner cb\" sExt = "*.xlsx" sDatei = Dir(sPfad & sExt) Application.ScreenUpdating = False Do While Len(sDatei) > 0 Set WB2 = Workbooks.Open(sPfad & sDatei) WB2.Worksheets(1).Rows(3).Copy WB1.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) WB2.Close sDatei = Dir() Loop End Sub

Servus ChrisL,
die Sache mit dem Tabelle2 funktioniert, allerdings die Sache mit dem anderen Ordner klappt irgendwie nicht.
Hier mal das Makro vlt siehst du was ich falsch gemacht habe.

Sub t()
Dim sPfad As String, sExt As String, sDatei As String
Dim WB1 As Workbook, WB2 As Workbook
Set WB1 = ThisWorkbook
sPfad = Left(WB1.Path, InStrRev(WB1.Path, "\") - 1)
sPfad = Left(sPfad, InStrRev(sPfad, "\")) & "Ordner c\Ordner cb\"
sExt = "*.f"
sDatei = Dir(sPfad & sExt)
Application.ScreenUpdating = False
Do While Len(sDatei) > 0
Set WB2 = Workbooks.Open(sPfad & sDatei)
WB2.Worksheets(1).Rows(3).Copy WB1.Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
WB2.Close
sDatei = Dir()
Loop
End Sub

Dann ist mir noch aufgefallen das wenn ich das Makro mehrfach ausführe die neuen Einträge immer unter die alten kommen, hätte es gerne so das die alten verschwinden und nur die neuen eingetragen werden.
Damit ich wirklich immer nur die aktuellen Einträge aus den Dateien habe.
Vielen vielen dank schonmal für deine spitzen Hilfe!
mfg Blue Bird

Sub t() Dim wb1 As Workbook, spfad As String Set wb1 = ThisWorkbook spfad = Left(wb1.Path, InStrRev(wb1.Path, "\") - 1) spfad = Left(spfad, InStrRev(spfad, "\")) & "Ordner c\Ordner cb\" MsgBox spfad End Sub

Sub t() Dim sPfad As String, sExt As String, sDatei As String Dim WB1 As Workbook, WB2 As Workbook Dim letzteZeile As Long Set WB1 = ThisWorkbook spfad = Left(wb1.Path, InStrRev(wb1.Path, "\") - 1) spfad = Left(spfad, InStrRev(spfad, "\") - 1) spfad = Left(spfad, InStrRev(spfad, "\") - 1) spfad = Left(spfad, InStrRev(spfad, "\")) & "Ordner c\Ordner cb\" sExt = "*.f" sDatei = Dir(sPfad & sExt) Application.ScreenUpdating = False Do While Len(sDatei) > 0 Set WB2 = Workbooks.Open(sPfad & sDatei) if WB1.Worksheets(2).Range("A1") = "" Then letzteZeile = 1 Else letzteZeile = WB1.Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row + 1 End If WB2.Worksheets(1).Rows(3).Copy WB1.Worksheets(2).Cells(letzteZeile,1) WB2.Close sDatei = Dir() Loop End Sub

Beliebteste Forumthreads (12 Monate)

Zeile aus externen Datei einlesen

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread