Clever-Excel-Forum

Guten Morgen zusammen,
ich habe ein Problem mit folgendem Code:

Sub FertigeWeg()
Dim rngAlle As Range, rngZelle As Range
For Each rngZelle In Application.Intersect(Columns(2), ActiveSheet.UsedRange)
  rngZelle.Select
  If rngZelle.Interior.ColorIndex = 4 Then
    If Not rngAlle Is Nothing Then
      Set rngAlle = Application.Union(rngAlle, rngZelle.Resize(, 12))
    Else
      Set rngAlle = rngZelle.Resize(1, 12)
    End If
  End If
Next rngZelle
If Not rngAlle Is Nothing Then
  rngAlle.Interior.ColorIndex = xlNone
  rngAlle.Copy Worksheets("Fertig").Cells(Rows.Count, 2).End(xlUp).Offset(1)
End If
End Sub

Der Code Kopiert farbig markiere Zellen von einem Tabellenblatt zum andernen per button, funktioniert auch.
Aber jetzte stehen in den zu Kopierenden Zellen keine Werte mehr sondern Formeln bzw. SVERWEISE nun möchte ich aber die Ergebnisse bzw. Werte kopieren
und nicht die Formeln. Wär cool wenn hier jemand helfen kann.

Danke schon mal.

VG
Tobi

Hallo Tobi,

Sub FertigeWeg()

  Dim rngAlle As Range, rngZelle As Range

  For Each rngZelle In Application.Intersect(Columns(2), ActiveSheet.UsedRange)

    If rngZelle.Interior.ColorIndex = 4 Then

      If Not rngAlle Is Nothing Then

        Set rngAlle = Application.Union(rngAlle, rngZelle.Resize(, 12))

      Else

        Set rngAlle = rngZelle.Resize(1, 12)

      End If

    End If

  Next rngZelle

  If Not rngAlle Is Nothing Then

    rngAlle.Interior.ColorIndex = xlNone

    rngAlle.Copy

    Worksheets("Fertig").Cells(Rows.Count, 2).End(xlUp).Offset(1).PasteSpecial xlPasteValues

    Application.CutCopyMode = False

  End If

End Sub

Gruß Uwe

funktionier...super dankeschön