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
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