aus XLS in Verz bestimmte Spalten kopieren
02.10.2009 02:02:31
Erich
Hallo Vorname, ( zu Vornamen und Nicknames schau bitte mal in die Forums-FAQ )
mit den Beispielen war es ein klein wenig besser zu verstehen, mal abgesehen davon,
dass in deinen beiden Quelldateien die Quellspalten D leer sind (da sollte es wohl Spalte B sein).
Eine Frage bleibt (wie so oft) offen:
Eine Excelmappe (xls-Datei) beinhaltet eine Anzahl Tabellenblätter (0 bis n)
(0 geht auch, wenn z. B. die Mappe nur ein Diagrammblatt enthält).
Auch deine Beispiel-Quellmappen haben 3 Tabellenblätter.
Aus welchem dieser Blätter sollen die Daten übernommen werden?
- Aus dem zufällig nach dem Öffnen gerade aktiven Blatt? (Geht schief,
wenn das aktive Blatt kein Tabellenblatt ist.)
- oder aus dem 1. Tabellenblatt der Mappe (Worksheets(1))?
- oder aus einem Tabellenblatt mit einem bestimmten Namen (Worksheets("abc"))?
Hier sind die ersten beiden Möglichkeiten enthalten, teste mal:
Option Explicit
Sub SammleD()
Dim strVz As String, strF As String, lngSp As Long
strVz = "c:\temp"
Workbooks.Add xlWBATWorksheet
If Right(strVz, 1) "\" Then strVz = strVz & "\"
Application.EnableEvents = False
' Application.ScreenUpdating = False ' NACH dem Test aktivieren
With ActiveWorkbook.Worksheets(1)
strF = Dir(strVz & "*.xls")
While strF ""
If strF ThisWorkbook.Name Then
lngSp = lngSp + 1
.Cells(9, lngSp) = Left(strF, Len(strF) - 4)
Workbooks.Open strVz & strF, False, True
' aus gerade aktivem Blatt
.Cells(10, lngSp).Resize(341) = ActiveSheet.Cells(10, 4).Resize(341).Value
' oder ' aus 1. Tabellenblatt der Mappe
.Cells(10, lngSp).Resize(341) = Worksheets(1).Cells(10, 4).Resize(341).Value
Workbooks(strF).Close False
End If
strF = Dir()
If lngSp = ActiveSheet.Columns.Count Then
MsgBox "In der Zieltabelle ist keine Spalte mehr frei."
strF = ""
End If
Wend
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort