Hallo Excel und VBA Profis,
Ich frage alle Arbeitsmappen im Ordner meiner "ausgehenden Datei" nach dem Sheet "Plan" ab,- wenn vorhanden, wird entsprechender Bereich kopiert.
Sub import()
Dim strDateiname As String
Dim wksZiel As Worksheet, wkbQuelle As Workbook, wksQuelle As Worksheet
Dim loLetzte1 As Long
Dim loLetzte2 As Long
Dim inLetzte As Integer
Dim i As Long
Worksheets("Import").Range("A6:K1000").ClearContents
Application.ScreenUpdating = True
strDateiname = Dir(ThisWorkbook.Path & "\*.xlsm")
Set wksZiel = ThisWorkbook.Worksheets("Import")
Do While strDateiname ""
If strDateiname ThisWorkbook.Name Then
Set wkbQuelle = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & strDateiname)
With wkbQuelle
For i = 1 To .Worksheets.Count
If .Worksheets(i).Name = "Plan" Then
Set wksQuelle = .Worksheets("Plan")
loLetzte1 = wksZiel.Cells(Rows.Count, 3).End(xlUp).Row
With wksQuelle
loLetzte2 = wksQuelle.Cells(Rows.Count, 2).End(xlUp).Row
inLetzte = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
.Range(.Cells(3, 1), .Cells(loLetzte2, inLetzte)).Copy _
Destination:=wksZiel.Cells(loLetzte1 + 1, 2)
End With
End If
Next i
.Close True
End With
End If
strDateiname = Dir
Loop
Set wkbQuelle = Nothing: Set wksQuelle = Nothing: Set wksZiel = Nothing
Application.ScreenUpdating = True
End Sub
soweit alles prima.
Meine Frage;
Könnte ein Profi das Makro so ändern, dass wenn entsprechender Quellbereich kopiert und in Zielbereich eingefügt, die entsprechenden Daten im Quellbereich gelöscht werden?
Wenn leichter umzusetzen, dann könnten auch Pauschal die Zeilen 3 bis 34 gelöscht werden.
Mit freundlichen Gruss
Fred