Copy the background color from another column-CodePudding

In column A1:A145 need code to highlight color. Apply format color in A1, how many rows? Base on the image1. enter image description here

In column A , 14 rows will have yellow, next 14 rows will have blue and so on. (number will always change) In column B need to repeat the number that appear in column D.

Looking for this result image 2 enter image description here

The below code only copy the color and number from column C at the end of row A:145, what we need is trying to highlight rows base on another cell value, working with sheet 1 until sheet 8 or more sheets.

Sub Color_My_Cells()

Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Dim Lastrowa As Long
Lastrowa = Cells(Rows.Count, "B").End(xlUp).Row
For i = 1 To Lastrowa
Cells(Lastrow, 1).Resize(Cells(i, 2).Value) = Cells(i, 2).Value
Cells(Lastrow, 1).Resize(Cells(i, 2)).Interior.Color = Cells(i, 2).Interior.Color
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row   1
Next
Application.ScreenUpdating = True
End Sub

CodePudding user response：

@GoalExcel the code below loops through all sheets in your Excel file and repeat the same steps for each one.

Sub ColorMyCells()
    
    Dim i, j, intRowCounterAB, intRowC As Integer
    
    For Each ws In ThisWorkbook.Sheets
        ws.Activate
        
        intRowC = Evaluate("=COUNTA(C:C)")
        intRowCounterAB = 1
    
        For i = 1 To intRowC
            For j = 0 To Range("C" & i).Value - 1
                Range("A" & intRowCounterAB).Interior.Color = Range("C" & i).Interior.Color
                Range("B" & intRowCounterAB).Value = Range("D" & i).Value
                intRowCounterAB = intRowCounterAB   1
            Next j
        Next i
    Next ws
    
End Sub