VBA Code for looping through the worksheets and active next cell then run the same command

[TheLSD]

Hi, I need help to give a tweak of a code that a friend give (thank you very much for it).

    'declare sheets
    Dim DivSheet As Worksheet, MasterSheet As Worksheet
    Set DivSheet = Sheets("Form Capex NPD") 'the sheet with the data
    Set MasterSheet = Sheets("Sheet4") 'where you want to put the copied data
    
    'declare ranges
    Dim originalDestinationCell As Range, nextDestCell As Range
    Set originalDestinationCell = MasterSheet.Range("C6") 'the first cell the data will be copied to
    Set nextDestCell = originalDestinationCell.Offset(-1, 0)
    Dim firstGreyCell As Range: Set firstGreyCell = DivSheet.Range("C6") 'the cell with the grey fill-color
    Dim rangeToSearchIn As Range: Set rangeToSearchIn = DivSheet.Range("C2:C2000") 'the range that the data is in
    'note: a larger range will take more time
    
    'move cell values
    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, 1) 'move the nextDestCell to the right by 1
                nextDestCell.Value = c.Value 'copy its value
            End If
        End If
    Next c
End Sub

What I need to make adjustments are:
after the code executed, move the selected cell to the end of the filled cells and run the code again through the worksheets inside the workbook (because the code only runs on the specified sheet only and I need to make it run through the entire worksheets inside the workbook).

Thank you!

[dangelor]

Possibly...

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("C2: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, 1) '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

[TheLSD]

thank you for the reply and it works like what I expected. But the problem within the code is that its also copying the header of the table. is there any fix for this? thanks so much

[dangelor]

Hard to tell without seeing the workbook. Suggest you attach a sample workbook.

[TheLSD]

hope the screenshot can explain the problem

Attachment 764927

[dangelor]

Your attachment isn't viewable.