AW: Wenn Werte ungleich dann kopieren
18.10.2020 19:55:47
volti
Hallo Andy,
wenn ich das richtig verstanden habe, bringt Dich vielleicht dies hier weiter:
Code:
[Cc]
Option Explicit
Sub Schaltfläche1_Klicken()
Dim LoLetzte As Long, LoLetzte2 As Long
Dim LoI As Long, WSh As Worksheet, iOfs As Integer
Set WSh = ActiveSheet
LoLetzte = IIf(IsEmpty(WSh.Cells(Rows.Count, 6)), WSh.Cells(Rows.Count, 6).End(xlUp).Row, _
WSh.Rows.Count)
For LoI = 1 To LoLetzte
On Error GoTo Fehler
iOfs = 1
Sheets(WSh.Cells(LoI, 6).Value).Select
On Error GoTo 0
LoLetzte2 = Cells(Rows.Count, 6).End(xlUp).Row + iOfs
WSh.Range("A" & LoI & ":F" & LoI).Copy Range("A" & LoLetzte2)
Next LoI
Exit Sub
Fehler:
Sheets.Add(after:=Sheets(Sheets.Count)).Name = WSh.Cells(LoI, 6)
iOfs = 0
Resume
End Sub
____________________
viele Grüße aus Freigericht
Karl-Heinz