Forumbeitrag
Excel-Version des Fragestellers:
365 privat
Erfahrungslevel des Fragestellers:
Basiskenntnisse in Excel
Hallo, ich bitte um eure Hilfe.
Nach Ausführen des unten stehenden Makros fehlen in den Spalten A und B:L in den Zeilen 1:98080 diese feine Linie, die man standardmäßig um jede Zelle herum in einem Excel Blatt sieht. Wie bekomme ich die wiederhergestellt.
Das Makro braucht ihr nicht zu ändern, damit es künftig nicht mehr passiert, das Makro war eine einmalige Sache.
Danke
Christian
Sub Codes_Format_And_Color_From_B()
Dim ws As Worksheet
Dim r As Long
Dim lastRow As Long
Dim colorVal As Long
Set ws = ThisWorkbook.Worksheets("Codes")
lastRow = 98080 ' Vorgabe laut Anforderung
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
For r = 1 To lastRow
' Schriftfarbe aus Spalte B holen
colorVal = ws.Cells(r, "B").Font.Color
' Schriftfarbe auf A und C:L übertragen
ws.Range(ws.Cells(r, "A"), ws.Cells(r, "L")).Font.Color = colorVal
' Formate (ohne Schriftfarbe) aus B auf A und C:L übertragen
ws.Cells(r, "A").Interior.Color = ws.Cells(r, "B").Interior.Color
ws.Cells(r, "A").Font.Name = ws.Cells(r, "B").Font.Name
ws.Cells(r, "A").Font.Size = ws.Cells(r, "B").Font.Size
ws.Cells(r, "A").Font.Bold = ws.Cells(r, "B").Font.Bold
ws.Cells(r, "A").Font.Italic = ws.Cells(r, "B").Font.Italic
ws.Cells(r, "A").HorizontalAlignment = ws.Cells(r, "B").HorizontalAlignment
ws.Cells(r, "A").VerticalAlignment = ws.Cells(r, "B").VerticalAlignment
ws.Range(ws.Cells(r, "C"), ws.Cells(r, "L")).Interior.Color = ws.Cells(r, "B").Interior.Color
ws.Range(ws.Cells(r, "C"), ws.Cells(r, "L")).Font.Name = ws.Cells(r, "B").Font.Name
ws.Range(ws.Cells(r, "C"), ws.Cells(r, "L")).Font.Size = ws.Cells(r, "B").Font.Size
ws.Range(ws.Cells(r, "C"), ws.Cells(r, "L")).Font.Bold = ws.Cells(r, "B").Font.Bold
ws.Range(ws.Cells(r, "C"), ws.Cells(r, "L")).Font.Italic = ws.Cells(r, "B").Font.Italic
ws.Range(ws.Cells(r, "C"), ws.Cells(r, "L")).HorizontalAlignment = ws.Cells(r, "B").HorizontalAlignment
ws.Range(ws.Cells(r, "C"), ws.Cells(r, "L")).VerticalAlignment = ws.Cells(r, "B").VerticalAlignment
Next r
' Autofit
ws.Columns("A:L").AutoFit
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Format- und Farbübertragung abgeschlossen.", vbInformation
End Sub