How to copy cells of specific colour of a worksheet and paste them in another workbook - excel

Question

I am very new to VBA and I was wondering how to copy only the white cells of a worksheet and paste them to the same places but to another workbook.
Specifically, I have two workbooks with multiple sheets and they are the same, but the source workbook has some white cells filled and the destination workbook has these cells empty. I want to transfer the values from the source white cells to the destination white cells.
Also if it is possible, I want to fill the empty white cells with "0".
I have found some pieces of code to copy all coloured cells to another excel worksheet but they do not transfer to another workbook and the exact places.
Sub CopyHighlightedTransactions()
Dim TransIDField As Range
Dim TransIDCell As Range
Dim ATransWS As Worksheet
Dim HTransWS As Worksheet
Set ATransWS = Worksheets("All Transactions")
Set TransIDField = ATransWS.Range("A2", ATransWS.Range("A2").End(xlDown))
Set HTransWS = Worksheets("Highlighted Transactions")
For Each TransIDCell In TransIDField
If TransIDCell.Interior.Color = RGB(255, 0, 0) Then
TransIDCell.Resize(1, 10).Copy Destination:= _
HTransWS.Range("A1").Offset(HTransWS.Rows.Count - 1, 0).End(xlUp).Offset(1, 0)
End If
Next TransIDCell
HTransWS.Columns.AutoFit
End Sub
Thank you in advance.

Answer 1

If the animation above is something that you mean (if I understand you correctly), maybe you want to try the sub below :
Sub test()
Dim wbS As Worksheet: Dim wbT As Worksheet
Dim rgData As Range: Dim c As Range
Application.ScreenUpdating = False
'prepare variable for the workbook and sheet of the source and target
Set wbS = Workbooks("Source.xlsm").Sheets("Sheet1") 'change as needed
Set wbT = Workbooks("Target.xlsx").Sheets("Sheet1") 'change as needed
'the range of the data to be searched
Set rgData = wbS.Range("A1:D10") 'change as needed
'prepare the color to be searched
With Application.FindFormat
.Clear
.Interior.Color = vbWhite
End With
'start searching as c variable
Set c = rgData.Find(What:=vbNullString, SearchFormat:=True)
'loop until all cells in rgData is checked if the color is white or not
'if found white then copy the c, paste to wbT with that c address
If Not c Is Nothing Then
FirstAddress = c.Address
Do
c.Copy Destination:=wbT.Range(c.Address)
Set c = rgData.Find(What:=vbNullString, after:=c, SearchFormat:=True)
Loop While c.Address <> FirstAddress
End If
End Sub
To test the code, make a copy of your workbook (both the source and the target). Copy the sub, paste on the copied workbook then run it. Both workbooks must be opened. It will take time if your data range is big as the code will check all the cell which has white color within the rgData.
the source workbook has some white cells filled
Please remember, the code is looking for the cell which is filled with white color.
I'm curious if the test2 sub below is faster because there's no loop.
Sub test2()
Dim rgW_orig As Range: Dim rgDest As Range
Dim rgW As Range: Dim rgX As Range
Dim rgBlank As range
Application.ScreenUpdating = False
Set rgW_orig = Sheets(1).Range("A1:D10")
Set rgDest = Workbooks("Target.xlsx").Sheets(1).Range(rgW_orig.Address)
With Application.FindFormat.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Workbooks.Add
Set rgW = ActiveSheet.Range(rgW_orig.Address)
rgW_orig.Copy Destination:=rgW
With rgW
.Replace What:="", Replacement:=True, LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=False
Set rgX = .SpecialCells(xlConstants, xlLogical)
End With
rgW.Value = "": rgX.Value = 1
set rgBlank = rgW.SpecialCells(xlBlanks)
rgW.Value = rgW_orig.Value
rgBlank.ClearContents
rgW.Copy
rgDest.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
True, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Close False
End Sub
The test2 macro use a new workbook as a helper, and assumes that the range of data in the Source.xlsm (where the macro reside) is the same within the range of data in the Target.xlsx.
First, it set a range the same address with rgW_orig in the new workbook as rgW variable. Then it copy the rgW_orig and paste it to rgW
Then within the new workbook (the helper workbook) :
it get all cells which filled with white color (by replacing the cell with white color with TRUE boolean), set it as rgX variable.
Next, it fill the whole range (the rgW) with blank, and fill the rgX with 1, then get all cells which has no value (blank) as rgBlank variable.
It copy again the rgW_orig into rgW, then clear the content of rgBlank. Now in this helper workbook within the rgW, the cells with value are only the one with white color, the rest are blank.
Finally it copy the rgW, paste "skip blank" into rgDest then close the helper workbook without saving.
Still not so sure though if this test2 sub is faster than the sub before.