Hi,
I have looked at a few codes and tried to put them together (crudely admittedly) but have gone wrong so hoping someone could point out my error!
I have a sheet with a list of tab on in Range I2:I23 as it can vary. I want a code to check each tab on two ranges, C5:H79 & C86:H160 and copy any non blank cells into a different tab, Collection into relevant column B3:G377.
I got it working on one column but when I expanded it to check all columns & go through the Tab range it stopped working but I can't see where!
I know I could loop it more but this code is the hardest I have ever tried!
Any help would be grateful!
Thanks for any help in advance!
I have looked at a few codes and tried to put them together (crudely admittedly) but have gone wrong so hoping someone could point out my error!
I have a sheet with a list of tab on in Range I2:I23 as it can vary. I want a code to check each tab on two ranges, C5:H79 & C86:H160 and copy any non blank cells into a different tab, Collection into relevant column B3:G377.
I got it working on one column but when I expanded it to check all columns & go through the Tab range it stopped working but I can't see where!

I know I could loop it more but this code is the hardest I have ever tried!
Any help would be grateful!
Code:
Sub EndofDayBanking() Dim strName As String
Dim C As Range
Set C1 = Sheets("Collection").Range("B3")
Set C2 = Sheets("Collection").Range("C3")
Set C3 = Sheets("Collection").Range("D3")
Set C4 = Sheets("Collection").Range("E3")
Set C5 = Sheets("Collection").Range("F3")
Set C6 = Sheets("Collection").Range("G3")
For i = 2 To 23
strName = Range("I" & i)
On Error Resume Next
Sheets(strName).Range ("C5:C79")
If Len(C.Value) > 0 Then
C.Copy
C1.PasteSpecial Paste:=xlPasteValues
Set C1 = C1.Offset(1, 0) '//advance to next cell below
End If
Sheets(strName).Range("C86:C160").ClearContents
If Len(C.Value) > 0 Then
C.Copy
C1.PasteSpecial Paste:=xlPasteValues
Set C1 = C1.Offset(1, 0) '//advance to next cell below
End If
Sheets(strName).Range("D5:D79").ClearContents
If Len(C.Value) > 0 Then
C.Copy
C2.PasteSpecial Paste:=xlPasteValues
Set C2 = C2.Offset(1, 0) '//advance to next cell below
End If
Sheets(strName).Range("D86:D160").ClearContents
If Len(C.Value) > 0 Then
C.Copy
C2.PasteSpecial Paste:=xlPasteValues
Set C2 = C2.Offset(1, 0) '//advance to next cell below
End If
Sheets(strName).Range("E5:E79").ClearContents
If Len(C.Value) > 0 Then
C.Copy
C3.PasteSpecial Paste:=xlPasteValues
Set C3 = C3.Offset(1, 0) '//advance to next cell below
End If
Sheets(strName).Range("E86:E160").ClearContents
If Len(C.Value) > 0 Then
C.Copy
C3.PasteSpecial Paste:=xlPasteValues
Set C3 = C3.Offset(1, 0) '//advance to next cell below
End If
Sheets(strName).Range("F5:F79").ClearContents
If Len(C.Value) > 0 Then
C.Copy
C4.PasteSpecial Paste:=xlPasteValues
Set C4 = C4.Offset(1, 0) '//advance to next cell below
End If
Sheets(strName).Range("F86:F160").ClearContents
If Len(C.Value) > 0 Then
C.Copy
C4.PasteSpecial Paste:=xlPasteValues
Set C4 = C4.Offset(1, 0) '//advance to next cell below
End If
Sheets(strName).Range("G5:G79").ClearContents
If Len(C.Value) > 0 Then
C.Copy
C5.PasteSpecial Paste:=xlPasteValues
Set C5 = C5.Offset(1, 0) '//advance to next cell below
End If
Sheets(strName).Range("G86:G160").ClearContents
If Len(C.Value) > 0 Then
C.Copy
C5.PasteSpecial Paste:=xlPasteValues
Set C5 = C5.Offset(1, 0) '//advance to next cell below
End If
Sheets(strName).Range("H5:H79").ClearContents
If Len(C.Value) > 0 Then
C.Copy
C6.PasteSpecial Paste:=xlPasteValues
Set C6 = C6.Offset(1, 0) '//advance to next cell below
End If
Sheets(strName).Range("H86:H160").ClearContents
If Len(C.Value) > 0 Then
C.Copy
C6.PasteSpecial Paste:=xlPasteValues
Set C6 = C6.Offset(1, 0) '//advance to next cell below
End If
Next i
Application.CutCopyMode = False
End Sub
Thanks for any help in advance!