Microsoft Excel

Herbers Excel/VBA-Archiv

Kopieren mit Bedingter Formatierung

Betrifft: Kopieren mit Bedingter Formatierung von: Sebastian
Geschrieben am: 21.10.2020 06:46:23

Hallo Profis,

ich habe mal eine Frage. Ich möchte aus Tabelle1 einen Bereich mit einer Bedingten Formatierung in die Tabelle2 kopieren. Ist sowas möglich ohne das ich die Formatierung bzw die Farben und werte behalte?

Hier mal mein Beispiel.
https://www.herber.de/bbs/user/140997.xlsx

Vielen Dank und viele Grüße
Sebastian

Betrifft: AW: Kopieren mit Bedingter Formatierung
von: Hajo_Zi
Geschrieben am: 21.10.2020 06:55:50

Hallo Sebatian,

die bedingte Formatierung kannst Du nicht einzeln kopieren.
Nur per VBA, das ist aber nicht gewünscht, da XLSX.

GrußformelHomepage

Betrifft: AW: Kopieren mit Bedingter Formatierung
von: Sebastian
Geschrieben am: 21.10.2020 06:58:56

Hallo Hajo,

ich würde auch mit VBA kopieren - XLSM würde auch gehen.

Viele Grüße und Danke Sebastian

Betrifft: AW: Kopieren mit Bedingter Formatierung
von: Hajo_Zi
Geschrieben am: 21.10.2020 07:06:14

Du möchtest keine XLSM Datei hochladen da Du den Code selber an Deine Bedingungen anpassen möchtest.
Viel Erfoilg
Ich bin dann raus, da Lösung erstellt.
Sub BedingteKorrigieren()
'******************************************************
'* 16.04.16                                           *
'* erstellt von Karin (Beverly), http://Excel-Inn.de
 *
'* Beverly_Forums@web.de                              *
'******************************************************
    Dim intSpalte As Integer
    Dim intZaehler As Integer
    Dim strBereich As String
    Dim arrBereich
    Dim intLetzte As Long
    Dim lngLetzte As Long
    Application.ScreenUpdating = False
    With ThisWorkbook.Worksheets("Projektinformationssystem")
        intLetzte = IIf(IsEmpty(.Cells(9, .Columns.Count)), .Cells(9, .Columns.Count).End( _
xlToLeft).Column, .Columns.Count)
        lngLetzte = .Rows.Count
        .Range(.Cells(10, 1), .Cells(lngLetzte, intLetzte)).FormatConditions.Delete
        For intSpalte = 1 To intLetzte
            If .Cells(2, intSpalte).FormatConditions.Count > 0 Then
                For intZaehler = 1 To .Cells(2, intSpalte).FormatConditions.Count
                    ReDim arrBereich(0 To 1)
                    strBereich = .Cells(2, intSpalte).FormatConditions(intZaehler).AppliesTo. _
Areas(1).Address
                    If IsNumeric(Right(strBereich, 1)) Then
                        arrBereich(0) = Range(strBereich).Cells(1).Address
                        arrBereich(1) = Range(strBereich).Cells(Range(strBereich).Cells.Count). _
Address
                        arrBereich(0) = Left(arrBereich(0), InStrRev(arrBereich(0), "$") - 1)
                        arrBereich(1) = Left(arrBereich(1), InStrRev(arrBereich(1), "$") - 1)
                        strBereich = Join(arrBereich, ":")
                        .Cells(2, intSpalte).FormatConditions(intZaehler).ModifyAppliesToRange  _
Range(strBereich)
                    End If
                Next intZaehler
            End If
        Next intSpalte
    End With
    Application.ScreenUpdating = True
End Sub
Gruß Hajo

Betrifft: AW: Kopieren mit Bedingter Formatierung
von: Herbert_Grom
Geschrieben am: 21.10.2020 09:39:58

Hallo Sebastian,

probiers mal damit:
   Sheets("Tabelle1").Range("D6:D17").Copy
   Sheets("Tabelle2").Range("E9:E20").PasteSpecial Paste:=xlFormats
   Application.CutCopyMode = False
Servus

Beiträge aus dem Excel-Forum zum Thema "Kopieren mit Bedingter Formatierung"