Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Kopieren von Werten und nicht Formeln Makro
#1
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
Antwortento top
#2
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
[-] Folgende(r) 1 Benutzer sagt Danke an Kuwer für diesen Beitrag:
  • tobi85
Antwortento top
#3
funktionier...super dankeschön
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste