AW: copy und paste rechnerleistung II
08.08.2003 13:38:30
richard
habe das problem anders gelöst.
geht jetzt alles in einem kopierschritt.
mußte dafür meine datengrundlage und das layout des zielnbereichs etwas anpassen, aber jetzt läuft es einwandfrei.
ich poste nochmal allen code, falls es jmd. interessiert ( ist ja schließlich nen forum hier)
Sub Kombinationen()
Dim Jahr As String
Dim Obergruppe
Dim Sparte
Dim Detail
Dim Monat
Dim varKombination
Dim b, c, d, e
Jahr = Year(Now())
Monat = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
Obergruppe = Array(1, 2)
Sparte = Array(1, 2, 3)
Detail = Array(1, 2, 3, 4, 5)
i = 1
For Each b In Sparte
For Each c In Obergruppe
For Each d In Detail
For Each e In Monat
i = i + 1
Worksheets(Jahr).Range("A" & i) = Jahr
Worksheets(Jahr).Range("B" & i) = b
Worksheets(Jahr).Range("C" & i) = c
Worksheets(Jahr).Range("D" & i) = d
Worksheets(Jahr).Range("E" & i) = e
Next e
Next d
Next c
Next b
End Sub
Sub Suchen_Kopieren()
Dim Suchbegriff As String
Dim zielreihe As Integer
Dim WSsource
Dim WStarget
Dim rngSource As Range
Dim rngTarget As Range
WSsource = "Rohdaten"
WStarget = "2003"
i = Worksheets(WSsource).Range("A65536").End(xlUp).Row
For f = 2 To i
Suchbegriff = Worksheets("Rohdaten").Range("R" & f).Value
On Error Resume Next
For x = 1 To Sheets("2003").Cells(65000, 19).End(xlUp).Row
If Sheets("2003").Cells(x, 19).Value = Suchbegriff Then
zielreihe = x
Exit For
End If
Next x
Set rngSource = Worksheets(WSsource).Range("E" & f & ":P" & f)
Set rngTarget = Worksheets(WStarget).Range("F" & x)
rngSource.Copy
rngTarget.PasteSpecial Paste:=xlValues, Transpose:=True
Next f
End Sub