Bereich kopieren in verschiedene Arbeitsmappen
17.08.2005 15:43:40
Daniel
ich habe mal wieder ein problemchen wo ich nicht klar komme. Ich habe Mappe1.xls wo ich ab zeile 5 den bereich "a5:dg5" einfügen möchte, den ich aus der Mappe2.xls auch aus zeile 5 den bereich "a5:dg5" herauskopiere (manuell --> copy/paste). Aus Mappe3.xls kopiere ich auch den bereich "a5:dg5" in die Mappe1.xls aber dann auf die nächste freie zeile, in diesem falle zeile6. Wenn ich den ersten kopy/paste befehl ausführe macht er dies auch ohne probleme. beim nächsten mal fügt er nur den bereich "b5:dg5" ein usw. er verschiebt den paste immer um eine zelle nach links. Untenstehender code habe ich gemacht.
gruss und danke daniel
Dim xlsArbeitsmappe As Workbook, xlsTabBlatt As Worksheet, xlsArbeitsmappe_R As Workbook, xlsTabBlatt_R As Worksheet, rngBereich As Range, rngBereich_R As Range, strBereich As String, rngZelle As Range, strWBName As String
Sub Hauptmodul()
Set xlsArbeitsmappe = Application.Workbooks("Geschäftsstandblatt_V_01.xls")
Set xlsTabBlatt = xlsArbeitsmappe.Worksheets("Geschäft")
xlsTabBlatt.Activate
Set rngBereich = Range("A5:A65536")
Call CopyRow(xlsArbeitsmappe.Name)
End Sub
Sub CopyRow(ByVal xlsArbeitsmappe As String)
Set xlsArbeitsmappe_R = Application.Workbooks(xlsArbeitsmappe)
Set xlsTabBlatt_R = xlsArbeitsmappe_R.Worksheets("Terminübersicht")
xlsTabBlatt_R.Activate
Set rngBereich_R = xlsTabBlatt_R.Range(("A5:DG5")
rngBereich_R.Copy
xlsTabBlatt.Activate
'* Erste freie Zeile adressieren und den kopierten Bereich einfügen
For Each rngZelle In rngBereich
If rngZelle.Value = "" Then
rngZelle.Select
rngZelle.Activate
xlsTabBlatt.Range(ActiveCell.Address).PasteSpecial Paste:=xlPasteAll
'* Ameisenlinie des festgelegten Kopierbereichs wird zurückgesetzt
Application.CutCopyMode = False
Exit For
End If
Next rngZelle
End Sub