VBA Code:
Sub Macro2()
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("Sheet1") '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:C1500") '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
this is the code I have to copy the C column of my datasheets on a workbook. What the code about is when there's data in column C then copy the word there and paste it in the master sheet, but if it is blank then ignore and move along to the next row and loop through all the worksheets.
what I need is to make the condition if it is blank then go to column E and copy the data contained inside the cells and if the C column contain data, back to column C and copy the data
below I attach the picture my problem
please help me by changing the code so it will run as what I expected
thank you