Objekdefinierter Fehler: Range Objekt
Heiko
ich blick gerade nicht durch:
Ich moechte per getOpenFilename mit multiselect mehrere Dateien oeffnen, eine nach der anderen, und die Daten aus Spalte 1 und 2 (bei der ersten Datei), danach Daten aus Spalte 2 in ein neues Sheet kopieren und zwar in die erste freie Spalte...
Leider bleibt der Code haengen mit "Anwendungs- oder Objektdefinierter Fehler" wegen der Range(Cells(x,y), Cells(x,y)) Geschichte.
Irgendwie habe ich die Workbooks.activeSheet.range... falsch definiert. Hab aber gerade keine Ahnung, wie's richtig heissen muss...
Kann mal jemand in den Code reinschauen?
Vielen Dank im Voraus,
Heiko
Sub append()
Dim thisWKB As Workbook
Dim sourceFile As Workbook
Dim nData As Integer
Dim numFiles As Integer
Dim fileToOpen As Variant
Dim i As Integer
Dim nextFree As Integer
fileToOpen = Application.GetOpenFilename("Excel Files (*.xls), *.xls", , "Select files to open", _
_
, True)
If TypeName(fileToOpen) = "Boolean" Then Exit Sub
numFiles = UBound(fileToOpen)
Set thisWKB = ThisWorkbook
For i = 1 To numFiles
Workbooks.Open fileToOpen(i)
Set sourceFile = Workbooks(Dir(fileToOpen(i)))
nData = sourceFile.ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row
nextFree = thisWKB.ActiveSheet.Cells(1, Columns.count).End(xlToLeft).Column + 1
If i = 1 Then
sourceFile.ActiveSheet.Range(Cells(1, 1), Cells(nData, 2)).Copy thisWKB.ActiveSheet. _
Range(Cells(1, 1), Cells(nData, 2))
Else
sourceFile.ActiveSheet.Range(Cells(1, 2), Cells(nData, 2)).Copy thisWKB.ActiveSheet. _
Range(Cells(1, nextFree), Cells(nData, nextFree))
End If
Workbooks(Dir(fileToOpen(i))).Close
Next i
End Sub