Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Inhalte von Exceltabellen in eine Tabelle überführen





Frage

Hallo, ich habe ein Problem bei einer Zusammenführung von Daten bei Excel. Ich habe ein paar hundert Exceldateien von denen ich jeweils eine Zeile ( und zwar die 7. Zeile des zweiten Tabellenblattes "Datenauswertung") in eine Sammeldatei überführen will. Ich habe auch schon ein Makro, dass jeweils die erste Spalte liest in Erfahrung gebracht und es funktioniert. Leider bin ich noch ein Anfänger beim Programieren, daher die Frage ob mir jemand helfen kann wie man eben besagte 7. Zeile des zweiten Blattes liest. Makro für die Spalte1 des 1.Blattes: Sub Makro01() Application.DisplayAlerts = False Dim i, zaehler1, zaehler2, zaehler3, a, b, 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) Next zaehler2 Workbooks(2).Close Next i End If End With Application.DisplayAlerts = True End Sub

Antwort 1 von fuddy

Hallo,

nach einigen Stunden Crashkurs VBA und ein paar Tassen Kaffee, habe ich die Lösung gefunden. Zwar habe ich noch nicht alles verstanden, aber es funktioniert.

Sub Makro01()
Application.DisplayAlerts = False
Dim i, zaehler1, zaehler2, a, b, 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.Column
a = lastcell.Column
Do While Application.CountA(Columns(a)) = 0 And a <> 1
a = a - 1
Loop
zaehler1 = zaehler1 + 1
For zaehler2 = 1 To 256
Workbooks(1).Sheets(1).Cells(zaehler1, zaehler2) = Workbooks(2).Sheets(2).Cells(7, zaehler2)
Next zaehler2
Workbooks(2).Close
Next i
End If
End With
Application.DisplayAlerts = True
End Sub


Gruß Fuddy

Antwort 2 von fedjo

Hallo,
versuch es doch mal mit diesem Cote.
Pfad "Sammeldatei" ändern!

Gruß
fedjo

Sub Makro1()
Sheets("Datenauswertung").Select
Rows("7:7").Copy
Workbooks.Open Filename:= _
"C:\Dokumente und Einstellungen\Admin\Eigene Dateien\Sammeldatei.xls" ´Pfad ändern
Range("A65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column).Activate
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWindow.Close
Sheets("Tabelle1").Select
End Sub