Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Daten aus 20 excel dateien in eine excel datei kopieren mit einem vba script





Frage

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

Antwort 1 von 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

Antwort 2 von nighty

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


Antwort 3 von 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

Antwort 4 von 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

Antwort 5 von Syrell

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

cu Syrell