Code optimieren
10.02.2014 12:19:06
Mario
ich würde so gern diesen Code etwas verschlanken und optimieren, kann mir da jemand helfen?
_
iZähler = 3
With Worksheets(Tab1).Range("b1:b500")
OK = 1
Set c = .Find(Trim(OK), LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Worksheets(Tab1).Range("C" & c.Row).Copy
Worksheets(Tab2).Range("A" & iZähler).PasteSpecial xlPasteValues
Worksheets(Tab1).Range("D" & c.Row).Copy
Worksheets(Tab2).Range("D" & iZähler).PasteSpecial xlPasteValues
Worksheets(Tab1).Range("J" & c.Row).Copy
Worksheets(Tab2).Range("E" & iZähler).PasteSpecial xlPasteValues
Worksheets(Tab1).Range("N" & c.Row).Copy
Worksheets(Tab2).Range("F" & iZähler).PasteSpecial xlPasteValues
Worksheets(Tab1).Range("F" & c.Row).Copy
Worksheets(Tab2).Range("G" & iZähler).PasteSpecial xlPasteValues
Worksheets(Tab1).Range("O" & c.Row).Copy
Worksheets(Tab2).Range("H" & iZähler).PasteSpecial xlPasteValues
Worksheets(Tab1).Range("O" & c.Row).Copy
Worksheets(Tab2).Range("H" & iZähler).PasteSpecial xlPasteValues
Worksheets(Tab1).Range("E" & c.Row).Copy
Worksheets(Tab2).Range("I" & iZähler).PasteSpecial xlPasteValues
iZähler = iZähler + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address firstAddress
End If
End With
Worksheets(Tab2).Select
Application.CutCopyMode = False