Herbers Excel/VBA-Archiv

Kopieren mit Bedingter Formatierung

• Kopieren mit Bedingter Formatierung von Sebastian vom 21.10.2020 06:46:23
• AW: Kopieren mit Bedingter Formatierung - von Hajo_Zi am 21.10.2020 06:55:50
  • AW: Kopieren mit Bedingter Formatierung - von Sebastian am 21.10.2020 06:58:56
    • AW: Kopieren mit Bedingter Formatierung - von Hajo_Zi am 21.10.2020 07:06:14
• AW: Kopieren mit Bedingter Formatierung - von Herbert_Grom am 21.10.2020 09:39:58

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.

  

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"