Daten in bestehendes Blatt kopieren statt in neues
07.02.2016 14:09:47
Mike
ich verwende folgenden Code, um Daten von verschiedenen Mappen in eine andere zu kopieren.
Das klappt soweit, allerdings gelingt es mir nicht, die Daten in ein bestehendes Blatt (Worksheets(2) ) einzufügen, sondern nur in ein neues.
Wenn ich statt varNewSheet Worksheets(2) verwende, dann erhalte ich den Fehler "out of range".
Kann mir jemand sagen, wie ich das richtig schreibe ? Das neue Blatt wird nicht benötigt, die Daten sollen nur in Blatt 2 eingefügt werden.
Mein Code:
Sub ImportFiles(varPath)
Dim objFile As Object
Dim objFolder As Object
Dim objFSO As Object
Dim varNewSheet As Worksheet
Dim varRowCount As Integer
Dim varSheet As Worksheet
Dim varWorkbook As Workbook
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(varPath)
Set varNewSheet = Worksheets.Add
For Each objFile In objFolder.Files
varRowCount = varNewSheet.UsedRange.Rows.Count
If objFile.Type = "Microsoft Excel Worksheet" Or objFile.Type = "Microsoft Excel Macro- _
Enabled Worksheet" Then
Set varWorkbook = Application.Workbooks.Open(varPath & objFile.Name)
Set varSheet = varWorkbook.Sheets(1)
varSheet.Range("B17:F49").Copy
varNewSheet.Activate
If varRowCount = 1 Then
varNewSheet.Cells(1, 1).Value = objFile.Name
varNewSheet.Cells(varRowCount + 1, 1).PasteSpecial Paste:=xlValue
Else
varNewSheet.Cells(varRowCount + 1, 1).Value = objFile.Name
varNewSheet.Cells(varRowCount + 2, 1).PasteSpecial Paste:=xlValue
End If
Application.DisplayAlerts = False
varWorkbook.Close
End If
Next
Application.DisplayAlerts = True
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing
MsgBox "Your import has been completed. :)", vbInformation, "Success"
End Sub
Mike