Kopieren von einzelnen Spalten wenn Bedingung erfü
29.10.2014 15:06:29
einzelnen
ich hab ein kleines problem mit einer Formel. Ich möchte gern einzelne zeilen kopieren dabei nur einzelne spalten kopieren. leider kopiert mein Code immer die ganze Tabelle aus der Quelle in das Ziel Arbeitsblatt. Kopiert werden soll wenn ein x in spalte :I oder W oder AK oder AY oder BM.
Sub test() 'copy in Agenda if date for the next Agenda
Dim a As Long, i As Long
Application.ScreenUpdating = False
a = 3
For i = 1 To 200
With Worksheets("Main sheet")
If .Cells(i, "I") = "x" Or .Cells(i, "W") = "x" Or .Cells(i, "AK") = "x" Or .Cells(i, "AY") = " _
x" Or .Cells(i, "BM") = "x" Then
.Rows(i).Copy _
Destination:=Worksheets("Agenda").Rows(a)
Worksheets("Agenda").Cells(a, 1).Value = Worksheets("Main sheet").Cells(i, 1).Value
Worksheets("Agenda").Cells(a, 2).Value = Worksheets("Main sheet").Cells(i, 2).Value
Worksheets("Agenda").Cells(a, 3).Value = Worksheets("Main sheet").Cells(i, 3).Value
Worksheets("Agenda").Cells(a, 4).Value = Worksheets("Main sheet").Cells(i, 4).Value
Worksheets("Agenda").Cells(a, 5).Value = Worksheets("Main sheet").Cells(i, 5).Value
Worksheets("Agenda").Cells(a, 6).Value = Worksheets("Main sheet").Cells(i, 9).Value
Worksheets("Agenda").Cells(a, 8).Value = Worksheets("Main sheet").Cells(i, 23).Value
Worksheets("Agenda").Cells(a, 10).Value = Worksheets("Main sheet").Cells(i,17).Value
Worksheets("Agenda").Cells(a, 12).Value = Worksheets("Main sheet").Cells(i,32).Value
Worksheets("Agenda").Cells(a, 14).Value = Worksheets("Main sheet").Cells(i,46).Value
a = a + 1
Else
End If
End With
Next i
Application.ScreenUpdating = True
End Sub
Gruß Jens