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
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
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
Ich möchte kostenlos eine Frage an die Mitglieder stellen:
Ähnliche Themen:
- Datenuebernahme in Excel
- Einem Zahlenwert einen vordefinierten Text zuordnen
- Zellbereiche aus verschiedenen Exceltabellen in eine neue Tabelle zusammenfassen
- Importieren von Ordnern mit Exceltabellen
- Hallo und Frage: Makro für Kontrollkästchen, beim aktivieren Zellen und Inhalte aus Tabelle einfügt und beim deaktvieren herausnimmt?