mit VBA 2 Blätter vergleichen

[Rabe]

Hi Sven,

Kann man eigentlich die Schrift im Feld dann auch Fett und Rot machen ?

klar:

Option Explicit

Const Farbe = 15   'Innenfarbe Hellgrau 

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim AC As Object
  Dim lngLetzte As Long
  Dim lngLetzte2 As Long
  
  Worksheets("Vergleich neu").Select
  lngLetzte = Cells(Rows.Count, 1).End(xlUp).Row    ' letzte belegte in Spalte A (1) 
  lngLetzte2 = Cells(1, Columns.Count).End(xlToLeft).Column 'letzte belegte Spalte in Zeile 1 
  
  'Schleife zum vergleichen und markieren 
  For Each AC In Range("A1:SD" & lngLetzte)
     With Worksheets("Vergleich alt")
        If .Cells(AC.Row, AC.Column) <> AC.Value Then
           AC.Interior.ColorIndex = Farbe
           AC.Font.Color = -16776961
           AC.Font.TintAndShade = 0
           AC.Font.Bold = True
        End If
     End With
  Next AC
End Sub

Sub entfärben()
  Dim lngLetzte As Long
  
  lngLetzte = Cells(Rows.Count, 1).End(xlUp).Row    ' letzte belegte in Spalte A (1) 
  
  With Range("A1:SD" & lngLetzte)
     .Interior.ColorIndex = xlNone
     .Font.ColorIndex = xlAutomatic
     .Font.TintAndShade = 0
     .Font.Bold = False
  End With
End Sub

Nun kann noch lngLetzte2 anstelle von SD verwendt werden:

Option Explicit

Const Farbe = 15   'Innenfarbe Hellgrau 

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim AC As Object
   Dim lngLetzte As Long
   Dim lngLetzte2 As Long
   
   Worksheets("Vergleich neu").Select
   lngLetzte = Cells(Rows.Count, 1).End(xlUp).Row    ' letzte belegte in Spalte A (1) 
   lngLetzte2 = Cells(1, Columns.Count).End(xlToLeft).Column 'letzte belegte Spalte in Zeile 1 

   'Schleife zum vergleichen und markieren 
   For Each AC In Range(Cells(1, 1), Cells(lngLetzte, lngLetzte2)) 'Range("A1:SD" & lngLetzte) 
      With Worksheets("Vergleich alt")
         If .Cells(AC.Row, AC.Column) <> AC.Value Then
            AC.Interior.ColorIndex = Farbe
            AC.Font.Color = -16776961
            AC.Font.TintAndShade = 0
            AC.Font.Bold = True
         End If
      End With
   Next AC
End Sub

Sub entfärben()
   Dim lngLetzte As Long
   Dim lngLetzte2 As Long
   
   Worksheets("Vergleich neu").Select
   lngLetzte = Cells(Rows.Count, 1).End(xlUp).Row    ' letzte belegte in Spalte A (1) 
   lngLetzte2 = Cells(1, Columns.Count).End(xlToLeft).Column 'letzte belegte Spalte in Zeile 1 
   
   With Range(Cells(1, 1), Cells(lngLetzte, lngLetzte2))
      .Interior.ColorIndex = xlNone
      .Font.ColorIndex = xlAutomatic
      .Font.TintAndShade = 0
      .Font.Bold = False
   End With
End Sub

[svenham]

Das klappt ! Super Danke.