Zeilen kopieren und einfügen
04.03.2004 09:52:30
Anita
ich versuch es nochmal: Mit folgendem Code werden Zeilen aus einer Tabelle in eine andere Tabelle kopiert, wenn das Suchkriterium in beiden Tabellen in Spalte R übereinstimmt.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WS2 As Worksheet
Set WS2 = ThisWorkbook.Worksheets("Datenbank")
If Target.Column <> 18 Then Exit Sub
With WS2
a = 0
For i = 1 To .Cells(65536, 18).End(xlUp).Row
If .Cells(i, 18) = Target Then
s = .Cells(i, 255).End(xlToLeft).Column
r = Cells(65536, 18).End(xlUp).Row + a
.Range(.Cells(i, 1), .Cells(i, s)).Copy Destination:=Cells(r, 1)
a = 1
End If
Next i
End With
End Sub
Die eingefügten Zeilen werden alle am Ende angefügt, sollen aber auch gegebenenfalls zwischendrin eingefügt werden, so dass alle anderen dann weiter nach unten rutschen. Hat jemand eine Idee, wie der Code verändert werden muss??
Vielen Dank für jeden Hinweis,
Anita
Anzeige