I have this Marco below currently working, I would like to add the function of also copying the cell background color too if possible.
Sub test()
Dim sh1 As Worksheet, sh As Worksheet
Dim f As Range
Dim j As Long, lr1 As Long, lr As Long
Set sh1 = Sheets("Labor Mapping")
With Sheets("Labor Mapping")
.Rows(2 & ":" & .Rows.Count).Clear
End With
For Each sh In Sheets
If sh.Name <> sh1.Name Then
lr1 = sh1.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row + 1
lr = sh.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
For j = 1 To sh.Cells(1, Columns.Count).End(1).Column
Set f = sh1.Rows(1).Find(sh.Cells(1, j), , xlValues, xlWhole, , , False)
If Not f Is Nothing Then
sh1.Cells(lr1, f.Column).Resize(lr).Value = sh.Cells(2, j).Resize(lr).Value
End If
Next
End If
Next
Sheets("Labor Mapping").Columns("G").Delete
End Sub
Not sure if this is what you are looking for, I think there might be a shorter way to put it, but I am trying to use the range attribute:
sh1.Range(sh1.Cells(lr1, f.Column),sh1.Cells(lr1, f.Column)).Interior.Color = sh.Range(sh.Cells(2, j),sh.Cells(2, j)).Interior.Color
2
You can use .Value(11)
instead of .Value
to copy values with base formatting.
sh1.Cells(lr1, f.Column).Resize(lr).Value(11) = sh.Cells(2, j).Resize(lr).Value(11)