Supportnet / Forum / Tabellenkalkulation

Hallo zusammen! ich habe folgende Problemstellung: ich möchte eine datei erg.xls mit daten aus xls-dateien aus einem fixen ordner füllen. Dabei soll aus jeder dieser dateien jeweils die spalte a und c spalte herauskopiert werden und fortlaufend in spalte a und spalte b der erg.xls datei kopiert werden, dann aus der nächsten datei wieder die spalte a und c in die spalte c und d von erg.xls und so fortlaufend. Kann da jemand ein script schreiben? thx Syrell

ach ja kopiert werden sollen nur die werteder zellen , weil manche zelle auch formeln enthalten. ich möchte nur die werte die diie formeln liefern

hi Syrell

ein beispiel

gruss nighty

Sub FilesListen()
Call EventsOff
Dim Dateien As Integer
Dim DateiName As String
ReDim Bereich1(1, 1) As Variant
ReDim Bereich2(1, 1) As Variant
With Application.FileSearch
.NewSearch
.LookIn = "c:\Temp\"
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
DateiName = Dir(.FoundFiles(Dateien))
If DateiName <> ThisWorkbook.Name Then
Workbooks.Open Filename:=.FoundFiles(Dateien)
ReDim Bereich1(Workbooks(DateiName).Sheets(1).Range("A" & Rows.Count).End(xlUp).Row - 1, 1)
ReDim Bereich2(Workbooks(DateiName).Sheets(1).Range("C" & Rows.Count).End(xlUp).Row - 1, 1)
Bereich1() = Range("A2:A" & Workbooks(DateiName).Sheets(1).Range("A" & Rows.Count).End(xlUp).Row).Value
Bereich2() = Range("C2:C" & Workbooks(DateiName).Sheets(1).Range("C" & Rows.Count).End(xlUp).Row).Value
ThisWorkbook.Sheets(1).Range("A" & ThisWorkbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1 & ":A" & (ThisWorkbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row + Workbooks(DateiName).Sheets(1).Range("A" & Rows.Count).End(xlUp).Row - 1)) = Bereich1()
ThisWorkbook.Sheets(1).Range("C" & ThisWorkbook.Sheets(1).Range("C" & Rows.Count).End(xlUp).Row + 1 & ":C" & (ThisWorkbook.Sheets(1).Range("C" & Rows.Count).End(xlUp).Row + Workbooks(DateiName).Sheets(1).Range("C" & Rows.Count).End(xlUp).Row - 1)) = Bereich2()
Workbooks(DateiName).Close SaveChanges:=True
End If
Next Dateien
End If
End With
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

hi!
erstmal danke für den code!
hab ihn getestet funktioniert zwar gut , aber: ^^

die daten sollen in die erg.xls wie folgt geschrieben werden: nicht untereinander die datensätze der einzelnen dateien , sondern neben einander; sprich aus quelldatei 1 spalte a,c in spalte a,b der erg-datei, dann aus quelldatei 2 wieder spalte a,c in spalte c,d der erg-datei, quelldatei 3 wieder spalte a,c in spalte e,f der erg-datei


vielleicht kannst du den code so modifizieren

thx SYRELL

hi!
erstmal danke für den code!
hab ihn getestet funktioniert zwar gut , aber: ^^

die daten sollen in die erg.xls wie folgt geschrieben werden: nicht untereinander die datensätze der einzelnen dateien , sondern neben einander; sprich aus quelldatei 1 spalte a,c in spalte a,b der erg-datei, dann aus quelldatei 2 wieder spalte a,c in spalte c,d der erg-datei, quelldatei 3 wieder spalte a,c in spalte e,f der erg-datei


vielleicht kannst du den code so modifizieren

thx SYRELL

hat keiner ne lösung für mich oder kann den obigen code modifizieren???

cu Syrell

• Ich möchte in Excel den Inhalte aller TXT-Dateien eines Verzeichnisses in ein Excel Blatt kopieren.
• Daten aus einer Excel-Datei in eine zweite kopieren
• Aus Mehren Excel- Dateien Daten in eine Excel Datei einlesen
• Excel: Tabellenblätter aus Dateien automatisch in eine einzige neue Datei kopieren
• Daten aus Excel nach Word kopieren, mit VBA