The attached code works perfectly for the first sheet, but on the second i get error "1004: Method 'Range' of object'_Worksheet' failed". I've attached an example of what the data looks like that i'm working with. We have a spreadsheet for every customer. I'm trying to copy the information into one spreadsheet in a database format. Since the customers may be located in different locations i'm trying to separate the information between the three regions.
Sub Compile2()
Dim sh As Worksheet
Dim UKsh As Worksheet
Dim EUsh As Worksheet
Dim USsh As Worksheet
Dim EUrow As Long, UKrow As Long, USrow As Long
Dim FinNum As Integer
EUrow = 2
UKrow = 2
USrow = 2
Set UKsh = Sheets("UK")
Set EUsh = Sheets("EU")
Set USsh = Sheets("US")
For Each sh In Worksheets
With sh
FinNum = 3
Do
If .Range("A60").Value = "EU" Then
.Range("B5").Copy
EUsh.Range("A" & EUrow).PasteSpecial Transpose:=True
.Range(Cells(8, FinNum), Cells(48, FinNum)).Copy
EUsh.Range("B" & EUrow).PasteSpecial Transpose:=True
EUrow = EUrow + 1
ElseIf .Range("A60").Value = "UK" Then
.Range("B5").Copy
UKsh.Range("A" & UKrow).PasteSpecial Transpose:=True
.Range(Cells(8, FinNum), Cells(48, FinNum)).Copy
UKsh.Range("B" & UKrow).PasteSpecial Transpose:=True
UKrow = UKrow + 1
Else
.Range("B5").Copy
USsh.Range("A" & USrow).PasteSpecial Transpose:=True
.Range(Cells(8, FinNum), Cells(48, FinNum)).Copy
USsh.Range("B" & USrow).PasteSpecial Transpose:=True
USrow = USrow + 1
End If
FinNum = FinNum + 1
Do Until FinNum > 7
Application.CutCopyMode = False
End With
Next
End Sub
Compile example.xlsm
Edit: I just tested it again, and now it is saying that I have a compile error "End With without With". So I have even more problems
Bookmarks