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

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.

CodePudding user response：

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.