1.7k Aufrufe
Gefragt in Tabellenkalkulation von
Hallo Leute ich hoffe euch geht es gut und ihr hattet ein angenehmes Wochenende.

Ich sitze am Montag Morgen vor einem Problem.

Ich muss die Daten aus 3060 "DBF" Dateien in ein Excel Arbeitsblatt bekommen.

Die Daten sind immer mit R0001.DBF fortlaufend benannt und liegen alle im gleichem Ordner auf der Festplatte.

Jetzt möchte ich die Daten hintereinander (alle Zellen mit Inhalt ausser die erste Zeile jeder Datei) in einem Artbeitsblatt meiner schon erstelleten Tabelle haben.
Ich habe es schon mit Makros aufzeichnen versucht aber ich kann dann immer nur eine Datei auswählen zum einfügen und die erste Zeile kommt auch immer mit.

Kann mir bitte jemand helfen ?

Vielen Dank !

8 Antworten

0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi :-)

wie gewünscht

gruss nighty

[code]Sub DateienLesen()
    Call EventsOff
    Dim DateiName As String
    DateiName = Dir("C:\Temp\" & "*.xls")
    Do While DateiName <> ""
        If ThisWorkbook.Name <> DateiName Then
            Workbooks.Open Filename:="C:\Temp\" & DateiName
            Workbooks(DateiName).Worksheets(1).Range("A2:A" & Workbooks(DateiName).Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row).Copy
            ThisWorkbook.Worksheets(1).Range("A" & ThisWorkbook.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlValues, Operation:=xlNone
            Workbooks(DateiName).Close SaveChanges:=True
        End If
        DateiName = Dir
    Loop
    Call EventsOn
End Sub[/code]
[code]Public Sub EventsOff()
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
End Sub [/code]
[code]Public Sub EventsOn()
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub[/code]
0 Punkte
Beantwortet von
Merci viel mal für deine schnelle Antwort nighty,

Kannst du mir bitte noch erklären wo ich welche Daten noch ergänzen muss ?
Ich habe keine Erfahrung mit der Programmiersprache deswegen schau ich da ewas in dir Röhre ...

Ich muss sicher den richtigen Pfad und die Dateinamen anfang bis Ende und Formate ordentlich eingeben.

Sorry wenn ich dir mit meinem Halbwissen die Zeit raube :-(
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi :-)

an 2 stellen wie zu sehen ist,den pfad aendern

eventuell quelle und ziel aendern,ist zur zeit bei beiden das 1 worksheet ,daher index 1

das wars dann

einzufugen alt+f11 projektexplorer allgemeines modul

gruss nighty
0 Punkte
Beantwortet von
Hey nighty,

ich habe es jetzt so drin und es öffnet nur eine Datei und es erzeugt auch eine neu Excel Tabelle es fürgt es nicht in mein Tabellenblatt ein.

Sub DateienLesen()
Call EventsOff
Dim DateiName As String
DateiName = Dir("C:\Ungesichert\TBM_Daten\Advance" & "121015_Vorlage_Mittelwertberechnung.xlsx")
Do While DateiName <> "R0000.DBF"
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:="C:\Ungesichert\TBM_Daten\Advance\R0000.DBF"
Workbooks(DateiName).Worksheets(1).Range("A2:A" & Workbooks(DateiName).Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Range("A" & ThisWorkbook.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlValues, Operation:=xlNone
Workbooks(DateiName).Close SaveChanges:=True
End If
DateiName = Dir
Loop
Call EventsOn
End Sub


Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Was mach ich nur falsch ?
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi :-)
aus pfade machst dateien und aus den variablen machst static

so kann das nicht gehen

sag mir deinen pfad an und welches worsheet angesprochen werden sollte

das erste oder das zweite etc

gruss nighty
0 Punkte
Beantwortet von
Hey :-)

also das ist der Pfad wo die Dateien dahinter liegen.
Die Dateine heissen" R0000.DBF" , "R0001.DBF", "R0002.DBF" usw. bis R3600.DBF

Die Excel Tabelle liegt im gleichen Pfad und heisst "121015_Vorlage_Mittelwertberechnung.xlsx"dort sollen die Daten in die zweite Arbeitsmappe die "HK-Daten" heisst.

Dort sollen die Daten aber der 4 Zeile eingefügt werden.

Ich danke vielmals !!!
0 Punkte
Beantwortet von
Der Pfad fehlt noch sorry

C:\Ungesichert\TBM_Daten\Advance
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi :-)

teste mal

gruss nighty

Sub DateienLesen()
Call EventsOff
Dim DateiName As String
DateiName = Dir("C:\Ungesichert\TBM_Daten\Advance \" & "*.xlsx")
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:="C:\Ungesichert\TBM_Daten\Advance \" & DateiName
'aendere noch bei der naechsten zeile,bei dieser silbe "A1:A" bis zu welcher spalte z.b. "A1:C"
Workbooks(DateiName).Worksheets(1).Range("A1:A" & Workbooks(DateiName).Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Range("A" & ThisWorkbook.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlValues, Operation:=xlNone
Workbooks(DateiName).Close SaveChanges:=True
End If
DateiName = Dir
Loop
Call EventsOn
End Sub

Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
...