Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Inhalte von 500 Dateien in Eine als Liste per Makro kopieren





Frage

Hallo liebe Leute, ich habe trotz intensiver Suche keine Lösung zu folgendem Problem gefunden - ich wäre sehr dankbar, wenn mir jemand helfen könnte: Es geht um eine Auswertung/Zusammenfassung einer Umfrage... ich habe 540 excel-Dateien/Arbeitsmappen unterschiedlichen Namens, jedoch gleicher Inhaltsstruktur, mit jeweils nur einem Blattregister. In Spalte A sind Fragen, in Spalte B sind Antworten. Diese 540 Arbeitsmappen möchte ich in einer neuen Arbeitsmappe zusammenfassen bzw. eine Liste erstellen, in der alle Fragen und Antworten der 540 Dateien untereinander stehen. Mit Pivot-Tabellen kann ich die entstandene Liste dann bequem zusammenfassen/auswerten. ABER: - Wie kann ich die 540 Dateien per Makro in eine Arbeitsmappe als Liste bringen, ohne, daß ich 540 mal alle Dateien öffnen und schließen muß? Ich habs schon mal mit dem Makrorekorder probiert, aber es hat nicht funktioniert (es wird immer wieder an die gleiche Stelle kopiert, statt untereinander...) Wer hat Ahnung? Für wen ist das kein Problem? -> der schreibe mir schnell.... Ich danke schon mal im Voraus! cu mckott

Antwort 1 von ComputerFee

Hallo mckott,

da die Dateien alle die gleiche Struktur ( gleiche Anzahl an Zeilen ) aufweisen, würde ich folgendermaßen vorgehen:

Du erzeugst einen DateiZaehler, den Du zu Beginn auf 0 initialisierst.

Beim Öffnen einer Datei, erhöhst Du den Zaehler um 1.
Um die Zeilen an die Sammeldatei anzuhängen, mußt du die jeweilige Zeile berechnen.
Beispiel:
2 Dateien mit jeweils 3 Zeilen:
Für Datei 1 gilt: 0 * 3 + OrginalZeile
ergibt: 1, 2 und 3
Für Datei 2 gilt: 1 * 3 + OrginalZeile
ergibt: 4, 5 und 6

In die errechnete Zeile schreibst Du dann die Zeile aus der Orginaldatei.


Ich hoffe, daß ich dir damit helfen konnte.


Gruß

ComputerFee



Antwort 2 von ComputerFee

Hi,

ich bins nochmal.

Mir kam gerade noch eine 2. Idee:

Du merkst Dir immer die Zeile in der Sammeldateo, in die Du gerade schreibst und erhöhst diese dann vor dem nächsten schreiben.
Damit müßte es auch funktionieren.


Gruß

ComputerFee

Antwort 3 von nighty

hi alle :)

liest beliebig viele dateien ein und liesst spalte a + b aus und fuegt sie in der aktuellen mappe spalte a + b wieder an ,einziges handicap da ja eh nur einmalig gebraucht also nicht so schlimm das bei den auszulesenden dateien eine freie zeile das auslesen der jeweiligen mappe beendet.

gruss nighty

Sub makro01()
Application.DisplayAlerts = False
Dim i, zaehler1, a, b, alta, altb, lzeile, lspalte
Dim lastcell As Range
With Application.FileSearch
.NewSearch

rem dein pfad der dateien
rem zu beachten das nur auszulesende dateien
rem sich darin befinden sollten
rem keine fehlerroutine praesent

.LookIn = "C:\test3"
.SearchSubFolders = False
.Filename = "*.*"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i)
Workbooks(1).Activate
Set lastcell = ActiveSheet.Cells.SpecialCells(xlLastCell)
alta = lastcell.Row
a = lastcell.Row
Do While Application.CountA(Rows(a)) = 0 And a <> 1
a = a - 1
Loop
alta = a
altb = lastcell.Column
b = lastcell.Column
Do While Application.CountA(Columns(b)) = 0 And b <> 1
b = b - 1
Loop
altb = b
lzeile = alta
lspalte = altb
Do
zaehler1 = zaehler1 + 1
If Workbooks(2).Sheets(1).Cells(zaehler1, 1) <> "" Then
Workbooks(1).Sheets(1).Cells(lzeile + zaehler1, 1) = Workbooks(2).Sheets(1).Cells(zaehler1, 1)
Workbooks(1).Sheets(1).Cells(lzeile + zaehler1, 2) = Workbooks(2).Sheets(1).Cells(zaehler1, 2)
Else
zaehler1 = 0
Exit Do
End If
Loop
Workbooks(2).Close
Next i
End If
End With
Application.DisplayAlerts = True
End Sub

Antwort 4 von nighty

hi alle :)

mag zwar nicht sooo perfekt sein doch wird es ja nur einmalig gebraucht :)

gruss nighty

Antwort 5 von nighty

hi mckott :)

cool aus berlin :)

bin aus SPANDAU(berlin eingemeindet) :) :)

gruss nighty

Antwort 6 von nighty

hi alle :)

ein wenig optimiert :)

gruss nighty

Sub makro01()
Application.DisplayAlerts = False
Dim i, zaehler1, zaehler2
With Application.FileSearch
.NewSearch
.LookIn = "C:\test3"
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i)
Do
zaehler1 = zaehler1 + 1
If Workbooks(2).Sheets(1).Cells(zaehler1, 1) <> "" Then
zaehler2 = zaehler2 + 1
Workbooks(1).Sheets(1).Cells(zaehler2, 1) = Workbooks(2).Sheets(1).Cells(zaehler1, 1)
Workbooks(1).Sheets(1).Cells(zaehler2, 2) = Workbooks(2).Sheets(1).Cells(zaehler1, 2)
Else
zaehler1 = 0
Exit Do
End If
Loop
Workbooks(2).Close
Next i
End If
End With
Application.DisplayAlerts = True
End Sub

Antwort 7 von nighty

hi alle :)

so ist fast perfekt :)

automatische abtastung der einlesenden dateien auf ende,es werden nur xls gelesen aus der angegebenen directory beliebig viele bzw. um die 65 535 glaub ich maximum :)

Sub makro01()
Application.DisplayAlerts = False
Dim i, zaehler1, zaehler2,a, alta, lzeile,lspalte
Dim lastcell As Range
With Application.FileSearch
.NewSearch
.LookIn = "C:\test3"
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i)
Set lastcell = ActiveSheet.Cells.SpecialCells(xlLastCell)
alta = lastcell.Row
a = lastcell.Row
Do While Application.CountA(Rows(a)) = 0 And a <> 1
a = a - 1
Loop
alta = a
lzeile = alta
For zaehler2 = 1 To lzeile
zaehler1 = zaehler1 + 1
Workbooks(1).Sheets(1).Cells(zaehler1, 1) = Workbooks(2).Sheets(1).Cells(zaehler2, 1)
Workbooks(1).Sheets(1).Cells(zaehler1, 2) = Workbooks(2).Sheets(1).Cells(zaehler2, 2)
Next zaehler2
Workbooks(2).Close
Next i
End If
End With
Application.DisplayAlerts = True
End Sub

Antwort 8 von nighty

hi alle :)

vielleicht hat ja noch einer dazu ideen.sieht irgendwie ungluecklich aus :(

Workbooks(1).Sheets(1).Cells(zaehler1, 1) = Workbooks(2).Sheets(1).Cells(zaehler2, 1)
Workbooks(1).Sheets(1).Cells(zaehler1, 2) = Workbooks(2).Sheets(1).Cells(zaehler2, 2)

gruss nighty

Antwort 9 von mckott

... und das geht! - einwandfrei!

Danke ComputerFee und nighty!

Ich bin echt begeistert! - Mann, spart man sich da eine Arbeit!

nighty - noch eine Frage an den Experten:

bin echt der absolute beginner in Sachen VBA, trotzdem interessiert mich noch - wie müßte das Makro aussehen wenn noch Spalte C und D und... dazukommen würde? Was muß ich da ändern?

Nochmal ein fettes Danke
und ein Lob an die Macher der site - ist ne feine Sache!

cu
mckott

Antwort 10 von ComputerFee

Hallo mckott,

wenn ich das richtig sehe, mußt Du nur die folgende Zeile duplizieren:

Workbooks(1).Sheets(1).Cells(zaehler1, 1) = Workbooks(2).Sheets(1).Cells(zaehler2, 1)

Anschließend bei dem 2. Parameter von Cells die '1' ( steht für 1. Spalte ) in die gewünschte Spalte umbenennen.


Gruß

ComputerFee

Antwort 11 von nighty

hi mckott :)

spaltenabtastung mit einbezogen

gruss nighty

Sub makro01()
Application.DisplayAlerts = False
Dim i, zaehler1, zaehler2, zaehler3, a, b, alta, altb, lzeile, lspalte
Dim lastcell As Range
With Application.FileSearch
.NewSearch
.LookIn = "C:\test3"
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i)
Set lastcell = ActiveSheet.Cells.SpecialCells(xlLastCell)
alta = lastcell.Row
a = lastcell.Row
Do While Application.CountA(Rows(a)) = 0 And a <> 1
a = a - 1
Loop
alta = a
altb = lastcell.Column
b = lastcell.Column
Do While Application.CountA(Columns(b)) = 0 And b <> 1
b = b - 1
Loop
altb = b
lzeile = alta
lspalte = altb
For zaehler2 = 1 To lzeile
zaehler1 = zaehler1 + 1
For zaehler3 = 1 To lspalte
Workbooks(1).Sheets(1).Cells(zaehler1, zaehler3) = Workbooks(2).Sheets(1).Cells(zaehler2, zaehler3)
Next zaehler3
Next zaehler2
Workbooks(2).Close
Next i
End If
End With
Application.DisplayAlerts = True
End Sub


Antwort 12 von mckott

du hast es richtig gesehen - das funktioniert!

Danke ComputerFee!

Antwort 13 von mckott

Hi nighty!

deins funktioniert auch! Danke auch dir!