Wie würdet ihr das angehen?
https://www.herber.de/bbs/user/113267.xlsm
Private Sub CommandButton1_Click()
Dim Zelle As Range
Dim shZiel As Worksheet
For Each Zelle In Sheets("Projekte offen").Columns(13).SpecialCells(xlCellTypeConstants, 2)
Select Case Zelle.Value
Case "ja", "nein"
If Zelle.Value = "ja" Then
Set shZiel = Sheets("Projekte Auftrag")
Else
Set shZiel = Sheets("Projekte verloren")
End If
With Zelle.MergeArea.EntireRow
.Copy
With shZiel.Cells(Rows.Count, 1).End(xlUp)
.Offset(.MergeArea.Rows.Count).PasteSpecial xlPasteAll
End With
.Delete
End With
Case Else
End Select
Next
End Sub
Gruß DanielPrivate Sub CommandButton1_Click()
Dim Zelle As Range
Dim shZiel As Worksheet
For Each Zelle In Sheets("Projekte offen").Columns(7).SpecialCells(xlCellTypeConstants, 2)
Select Case Zelle.Value
Case "ja", "nein"
If Zelle.Value = "ja" Then
Set shZiel = Sheets("Projekte Auftrag")
Else
Set shZiel = Sheets("Projekte verloren")
End If
With Zelle.MergeArea.EntireRow
.Copy
With shZiel.Cells(Rows.Count, 1).End(xlUp).Resize(1, 1)
.Offset(1, 0).PasteSpecial xlPasteAll
End With
End With
Case Else
End Select
Next
With Sheets("Projekte offen").Columns(7)
.Replace "ja", 1, xlWhole
.Replace "nein", 1, xlWhole
If WorksheetFunction.Sum(.Cells) > 0 Then
.SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete
End If
End With
End Sub