Makro zum kopieren von Zeile wenn Wort drin steht

[l2amzZ]

Code:

Sub test()

Dim Zeile As Long

Dim ZeileMax As Long

Dim n As Long
Dim celltxt As String
With Tabelle1

ZeileMax = .Cells.SpecialCells(xlCellTypeLastCell).Row 'hole länge der Tabelle als Iterationsendbedingung


n = 2 'Startzeile Für die Zieltabelle des ersten iterationsschritts



For Zeile = 2 To ZeileMax ' ab zeile 2 da Tabelle überschriften hat

If .Cells(Zeile, 2).Value = "abc" And .Cells(Zeile, 1).Value <> "0" Then

.Rows(Zeile).Copy Destination:=Tabelle6.Rows(n) 'erster Iterationsschritt Kopie der Zeile wenn abc vorkommt auf ein anderes Blatt

celltxt = ActiveSheet.Cells(Zeile, 13).Text 'mein Versuch das Wort das Wort Max in der jeweiligen Zeile zu suchen
If InStr(1, celltxt, "Max") Then

Worksheets(Tabelle1).Range(Cells(Zeile, 1), Cells(Zeile, 13)).Copy Destination:=Worksheets(Tabelle6).Range(Cells(n, 20), Cells(n, 33))
'Er soll zeile n spalte 1 bis zeile n Spalte 13 in die Felder Zeile n Spalte 20 und daneben kopieren

End If


n = n + 1

End If
Next Zeile
End With

End Sub

Hallo zusammen,

ich tüftel an einem Makro, welches wenn das Wort "Max" in einer Zeile vorkommt, die Elemente die in der Zeile dieser Tabelle Stehen kopiert und in eine Neue Tabelle weiter rechts einfügt.

Dabei geht das Program Iterativ Zeile für Zeile vor... Dabei Kopiert er zuerst eine ganze zeile wenn ein bestimmter name Vorkommt. Als Nächstes soll die zeile gleichzeitig auf einen weiteren namen geprüft werden und wenn dieser auftaucht einen Tabellenbereich nach rechts kopieren

Der Code steht und der Erste Teil der Iteration klappt. der 2. ist jedoch wirkungslos :(

Hat jemand eine Idee? liegt wahrscheinlich am Range Befehl. der hat viel rumgemeckert..

Ich danke euch!

[Kuwer]

Hallo,

ungetestet:

Sub test()
 Dim Zeile As Long
 Dim ZeileMax As Long
 Dim n As Long
 Dim celltxt As String
 With Tabelle1
   ZeileMax = .Cells.SpecialCells(xlCellTypeLastCell).Row 'hole länge der Tabelle als Iterationsendbedingung
   n = 2 'Startzeile Für die Zieltabelle des ersten iterationsschritts
   For Zeile = 2 To ZeileMax ' ab zeile 2 da Tabelle überschriften hat
   If .Cells(Zeile, 2).Value = "abc" And .Cells(Zeile, 1).Value <> "0" Then
     .Rows(Zeile).Copy Destination:=Tabelle6.Rows(n) 'erster Iterationsschritt Kopie der Zeile wenn abc vorkommt auf ein anderes Blatt
     celltxt = .Cells(Zeile, 13).Text 'mein Versuch das Wort das Wort Max in der jeweiligen Zeile zu suchen
     If InStr(1, celltxt, "Max") Then
       .Cells(Zeile, 1).Resize(1, 13).Copy Destination:=Worksheets("Tabelle6").Cells(n, 20)
       'Er soll zeile n spalte 1 bis zeile n Spalte 13 in die Felder Zeile n Spalte 20 und daneben kopieren
     End If
     n = n + 1
   End If
   Next Zeile
 End With
End Sub

Gruß Uwe

[IchBinIch]

gelöscht war noch nicht fertig :s