VBA code for copying the word from specific datasheets

TheLSD

New Member
Joined
Jan 12, 2022
Messages
33
Office Version
  1. 2010
Platform
  1. Windows
Hi, so I have a code that I got from my friend (Thank you for it) but it seems that the code needs a tweak as the data that I required to through the datasheets was also copied horizontally and copied the header of the table. The code itself mentions that if the data on the grey-colored cell is copied while if it is blank then skip to the next grey-contained cell but I need to make some new adjustments if the grey cell is blank then go to the next 2 columns (from C to E in this case) and copy all the E column data until its empty. If the data in column E is left blank then go back to column C, the grey colored one, and copy the contained words again. Could I also make this vba code run when opening the file?
Thank you gurus!

Below I attach the code and the screenshot of my problem. Hope it can explain clearly my problem.

This is the code that copies through all the datasheets
VBA Code:
Sub Not_Tested()
    Dim ws As Worksheet, MasterSheet As Worksheet
    Dim originalDestinationCell As Range, nextDestCell As Range
    Dim firstGreyCell As Range, rangeToSearchIn As Range, c As Range

    Set MasterSheet = Sheets("Sheet4")            'where you want to put the copied data
    Set originalDestinationCell = MasterSheet.Range("C6") 'the first cell the data will be copied to
    Set nextDestCell = originalDestinationCell.Offset(-1, 0)
    
    For Each ws In ThisWorkbook.Worksheets
        If Not ws.Name = MasterSheet.Name Then
            Set firstGreyCell = ws.Range("C6")
            Set rangeToSearchIn = ws.Range("C6:C2000") 'the range that the data is in
            
            For Each c In rangeToSearchIn
                If IsEmpty(c) = False Then        'only copy if the cell is not blank
                    If c.Interior.Color = firstGreyCell.Interior.Color Then
                        'if the interior color of cell 'c' is the same as 'firstGreyCell' then
                        Set nextDestCell = MasterSheet.Cells(nextDestCell.Row + 1, originalDestinationCell.Column)
                        'move the next cell down one column and back to the original column
                        nextDestCell.Value = c.Value 'copy the value to the recap sheet
                        nextDestCell.Interior.Color = c.Interior.Color 'copy the cell color too
                    Else
                        'if the interior color is not the same as 'c'
                        Set nextDestCell = nextDestCell.Offset(0, 2) 'move the nextDestCell to the right by 1
                        nextDestCell.Value = c.Value 'copy its value
                    End If
                End If
            Next c
        End If
    Next ws
End Sub
 

Attachments

  • Screenshot 2022-01-25 085158.png
    Screenshot 2022-01-25 085158.png
    47.4 KB · Views: 27

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

Forum statistics

Threads
1,223,231
Messages
6,170,884
Members
452,364
Latest member
springate

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top