Supportnet / Forum / Tabellenkalkulation

Hallo, Ich habe den unten stehenden VBA-Code im Einsatz, den möchte ich so abändern das nur kopiert wird wenn in der Spalte14 ein kleines oder ein großes X steht. ´kopiert alle Zeilen mit einem Inhalt in Spalte 14, nach Tabelle2. Dim lRow As Long, lRowL As Long, lRowT As Long, bln As Boolean Application.StatusBar = "Aktualisierung läuft !!!" Sheets("Tabelle1").Activate lRowL = Cells(Rows.Count, 14).End(xlUp).Row lRowT = 1 For lRow = 2 To lRowL If Not IsEmpty(Cells(lRow, 14)) Then lRowT = lRowT + 1 Sheets("Tabelle2").Rows(lRowT).Value = Rows(lRow).Value End If Next lRow End Sub Ein Danke an alle Helfer !!!

Hallo Zappa,

ich habe das jetzt mal so verstanden, dass nur dann kopiert werden soll, wenn genau ein einzelnes kleines oder großes X in Spalte 14 steht, und nicht wenn es innerhalb einer Zeichenfolge vorkommt. Allerdings habe ich noch ein Trim() (= Variante 2) verwendet, so dass vor und hinter dem X noch Leerzeichen stehen können und trotzdem kopiert wird. Wenn das nicht so sein soll, dann tauschst Du die If-Zeile aus. In den Rem-Kommentarzeilen sind beide Varianten angegeben.

Sub X_in_Sp14_kopieren()
Rem Kopiert alle Zeilen mit "x" oder "X" in Spalte 14, nach Tabelle2

Dim lRow As Long, lRowL As Long, lRowT As Long, bln As Boolean
Application.StatusBar = "Aktualisierung läuft !!!"
Sheets("Tabelle1").Activate
lRowL = Cells(Rows.Count, 14).End(xlUp).Row
lRowT = 1
For lRow = 2 To lRowL

Rem Wahlweise eine der beiden If-Zeilen - ohne Rem - verwenden
Rem 1) Nur kleine oder große X sind erlaubt
Rem If LCase(Cells(lRow, 14).Value) = "x" Then
Rem 2) Leerzeichen vor/hinter dem X sind erlaubt
Rem If Trim(LCase(Cells(lRow, 14).Value)) = "x" Then
If Trim(LCase(Cells(lRow, 14).Value)) = "x" Then

lRowT = lRowT + 1
Sheets("Tabelle2").Rows(lRowT).Value = Rows(lRow).Value
End If
Next lRow

End Sub

Gruß,
CaroS

hi all

noch eine variante ohne schleife

gruss nighty

Option Explicit
Sub test()
Sheets(1).Range("B1:B100").AutoFilter field:=1, Criteria1:="x", VisibleDropDown:=False
Sheets(1).Rows(2 & ":" & Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row).Copy _
Sheets(2).Rows(Sheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
Sheets(1).Cells(1, 2).AutoFilter field:=1
End Sub

hi all :)

idee von schnallgonz :))

gruss nighty

hi all

ups korrigiert

gruss nighty

Option Explicit
Sub test()
Sheets(1).Range("B1:B" & Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row).AutoFilter field:=1, Criteria1:="x", VisibleDropDown:=False
Sheets(1).Rows(2 & ":" & Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row).Copy _
Sheets(2).Rows(Sheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
Sheets(1).Cells(1, 2).AutoFilter field:=1
End Sub

Hallo CaroS
habe deine Variante probiert, leider funzt es bei mir
nicht !
Egal was in der Spalte 14 steht, sie wird immer kopiert.

Gruß
Zappa

hi zappa

ab zeile 2 spalte 14 (N)

das 2 sheet dient der darstellung zur zeit

gruss nighty

Option Explicit
Sub test()
Sheets(1).Range("N2:N" & Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row).AutoFilter field:=1, Criteria1:="x", VisibleDropDown:=False
Sheets(1).Rows(2 & ":" & Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row).Copy _
Sheets(2).Rows(Sheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
Sheets(1).Cells(1, 14).AutoFilter field:=1
End Sub

Hallo Zappa,

fällt mit schwer das zu glauben, aber was kann man jetzt machen? Startest Du denn das richtige Makro? Ich könnte Dir zwar noch empfehlen, das Makro schrittweise mit F8 abzuarbeiten, dabei Variablen zu überwachen, aber eigentlich sehe ich keinen Fehler.

Spalte 14 ist Spalte N, sind da bei Dir irgendwelche Spalten verdeckt (Breite = 0)? Wenn in N2, N3 usw. nichts oder etwas beliebiges außer x oder X steht, musst Du im Makro mit F8 von der Zeile

If Trim(LCase(Cells(lRow, 14).Value)) = "x" Then

(nach unten) direkt zur Zeile

Next lRow

und mit dem nächsten F8 (nach oben) zur Zeile

For lRow = 2 To lRowL

springen. Überprüfe das bitte mal.

Gruß,
CaroS

Sorry CaroS,
ich hatte vergessen das ich das Makro auch noch im
"Workbook_open" laufen hatte.
Deine Lösung des Problems funktioniert super.

Ein Danke an alle die geholfen haben.
(Die Lösung von Nighty werde ich auch mal testen)

• Automatisches Kopieren variabler Datenbereiche auf ein neues Blatt
• Zeilen, die in Spalte 9 ein X enthalten in anderes Blatt kopieren
• Makro soll die richtige Zeile finden
• Tabelle vergleichen und aktualisiren
• Nur spezielle Daten (mit Wert in Spalte A) aus anderer Tabelle kopieren - Excel 2003