AW: Bereiche kopieren
17.05.2006 00:19:46
Franz
Hallo Michael,
nachfolgendes Makro überträgt die Daten aus der Ausggangstabelle in die 10 Einzeltabellen.
Sub datentransfer()
Dim wks1 As Worksheet, wks2 As Worksheet
Dim I As Integer, Daten As Range
Set wks1 = Worksheets("Ausgangsdaten")
For I = 1 To 10
Set wks2 = Worksheets(Format(I, "0"))
'vorhandene Daten im Zielbereich löschen
wks2.Range(wks2.Cells(6, 1), wks2.Cells(1000, 3)).ClearContents
'Übertragen von Kostenarten und Text
With wks1
Set Daten = .Range(.Cells(2, 1), .Cells(.UsedRange.Row + .UsedRange.Rows.Count - 1, 2))
End With
Daten.Copy wks2.Cells(6, 1)
'Übertragen PSP-Element
wks2.Cells(4, 2).Value = wks1.Cells(1, I + 2)
'Übertragen Plankosten
With wks1
Set Daten = .Range(.Cells(2, I + 2), .Cells(.UsedRange.Row + .UsedRange.Rows.Count - 1, I + 2))
End With
Daten.Copy wks2.Cells(6, 3)
Next I
End Sub
Falls auch die Anzahl der PSP-Elemente variiert, dann muss man die Schleifen anders aufbauen und ggf. auch das Einfügen weiterer Tabellenblätter integrieren.
Gruß
Farnz