habe eine "neue" datei angefügt - vielleicht ist es nun ersichtlicher wie das ganze aussehen soll.
danke allen heinzelmännchen und -frauen...
lg stephan
aufgezeichneter code??
Hallo,
unten Dein Code korrigiert:
Code:
Sub kopieren1()
Dim variable As String
variable = Sheets("Kriterienraster").Range("P1")
With Sheets(variable).UsedRange
.AutoFilter
.AutoFilter Field:=9, Criteria1:="Ja"
.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
End With
With Sheets("Kriterienraster")
.Cells(.Rows.Count, 2).End(xlUp).Offset(1, -1).PasteSpecial xlPasteValues
End With
Sheets(variable).UsedRange.AutoFilter
End Sub
statt
Criteria1 stand bei Dir
[b]Criterial[/b]
Dann wird bei Dir der Bezug immer wieder vermischt.
So variable = [P1] wird der Wert aus der gerade aktiven Tabelle ausgelesen. Das kann dann schon zu Fehlern führen.
Diese Zeile:
Code:
Sheets("Kriterienraster").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
ist auch nicht eindeutig, falls die aktive Tabelle nicht "Kriterienraster" ist.
Dieser Teil:
Code:
Sheets("Kriterienraster").Cells(Rows.Count, 1)
bezieht sich auf "Kriterienraster"
Was dahinter kommt, bezieht sich auf das gerade aktive Blatt.
Vergleich Deinen mit dem von mir eingestellten, dann erkennst Du vielleicht auch einiges selber.
Hallo noch mal,
und so geht es ohne Filtern:
Code:
Sub kopieren()
Dim strgSheet As String
Dim Zeile As Long
Dim ZeileMax As Long
Dim lngErste As Long
Dim n As Long
With Sheets("Kriterienraster")
strgSheet = .Range("P1")
lngErste = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
End With
n = lngErste
With Sheets(strgSheet)
ZeileMax = .UsedRange.Rows.Count
For Zeile = 2 To ZeileMax
If .Cells(Zeile, 9).Value = "Ja" Then
.Rows(Zeile).Copy Destination:=Sheets("Kriterienraster").Rows(n)
n = n + 1
End If
Next Zeile
End With
End Sub
Wenn es viele Daten sind, dann würde entweder mit dem Spezialfilter arbeiten oder Arrays einsetzen.
hallo atilla
mit dem von dir geposteten code funktioniert es perfekt...vielen dank und allen an dieser stelle nochmals vielen dank fürs mitdenken...
viele grüsse
stephan