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