VBA Copy Paste with Direct Cell links

[WWII_Buff]

Here is what I am trying to do.


I have 50+ worksheets with identical headers but different row lengths and data. Rows "A4:BA4" are the headers, A5:BA... is all data. I would like to combine all 50 sheets into one worksheet called "Master".


#1 , I'd like to bring over the header from the 1st worksheet as well, but not the subsequent worksheets.
#2 , I'd like to skip blank rows on all sheets
#3 , Instead of copy paste special value, I need the "Master" tab data to directly link to the specific worksheet e.g.

FormulaR1C1 = "='27900'!R[3]C[-1]"

where 27900 = a sheet name


Thank you all so much!

 

[WWII_Buff]

Ummm let me check that.

 

[WWII_Buff]

This is what I have in my module, it is in a module by itself, if that makes a difference.

Sub test() With Worksheets("2018_EXP")
 lr = .Cells(Rows.Count, "D").End(xlUp).Row
  looktbl = Range(.Cells(1, 1), .Cells(lr, 9))
 End With
 With Worksheets("Master")
indi = 5
firstt = True
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
 If (ws.Name <> "Master") Then
 If (ws.Name <> "2018_EXP") Then
 If (ws.Name <> "2017_EXP") Then
 If (ws.Name <> "2018_WASTE_VOL") Then
 If (ws.Name <> "2017_WASTE_VOL") Then
 If (ws.Name <> "Presentation") Then
 If (ws.Name <> "DATASHEET") Then
 If (ws.Name <> "SITE PCC VIEW") Then


      ws.Select
    CostC = Range(Cells(1, 2), Cells(1, 2))
    Costype = ""
    For k = 1 To lr
     If CostC = looktbl(k, 4) Then
      ' Cost centre found
       Costype = looktbl(k, 9)
       Exit For
     End If
    Next k
   If firstt Then
    headers = Range(Cells(1, 1), Cells(4, 53))
    headers(1, 7) = "Cost Center Type"
    firstt = False
   End If
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    inarr = Range(Cells(5, 1), Cells(LastRow, 54))
    For i = 1 To LastRow - 4
     For j = 1 To 53
     retr = "r" & (4 + i) & "C" & j
     inarr(i, j + 1) = "=" & ws.Name & "!" & retr
     Next j
     ' put in the cost centre and cost type
     inarr(i, 1) = CostC
     inarr(i, 7) = Costype
    Next i
    Range(.Cells(indi, 1), .Cells(indi + LastRow - 5, 54)).Formula = inarr
    indi = indi + LastRow - 4
 End If
 End If
Next ws
 Range(.Cells(1, 2), .Cells(4, 54)) = headers
 Range(.Cells(1, 1), .Cells(1, 1)) = "Cost Center"




End With




End Sub

 

[WWII_Buff]

The only difference between my test and the go live version are the number of tabs that I excluded from the loop.

 

[offthelip]

You are missing a load of endifs go back to the original coxe and put the if statements in one by one adding the endif as you go.

 

[WWII_Buff]

Ahh! So each

 If (ws.Name <> "2018_EXP") Then

Needs a

End If

, but where?

Here?

 End If End If
Next ws
 Range(.Cells(1, 2), .Cells(4, 54)) = headers
 Range(.Cells(1, 1), .Cells(1, 1)) = "Cost Center"

 

[offthelip]

Yes, but they need a line for each one

 

[WWII_Buff]

This returned an error too.

.
.
.
 inarr(i, 1) = CostC
 inarr(i, 7) = Costype
 Next i
 Range(.Cells(indi, 1), .Cells(indi + LastRow - 5, 54)).Formula = inarr
 indi = indi + LastRow - 4
 End If
 End If
 End If
 End If
 End If
 End If
 End If
 End If
 Next ws
 Range(.Cells(1, 2), .Cells(4, 54)) = headers
 Range(.Cells(1, 1), .Cells(1, 1)) = "Cost Center"

 

[offthelip]

I can't help you with no information, what error on what line and post all the code

 

[WWII_Buff]

I hope I am not being difficult.

This is the same error. It is erroring out at LastRow= (highlighted in blue)

Compile error: Argument not optional here:

End If
[FONT=Verdana]LastRow = Cells(Rows.Count, "A").End(xlUp).Row[/FONT]

What's weird is the yellow arrow is at the beginning Sub test().

 

[WWII_Buff]

This what I have:

Sub test() With Worksheets("2018_EXP")
 lr = .Cells(Rows.Count, "D").End(xlUp).Row
  looktbl = Range(.Cells(1, 1), .Cells(lr, 9))
 End With
 With Worksheets("Master")
indi = 5
firstt = True
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
 If (ws.Name <> "Master") Then
 If (ws.Name <> "2018_EXP") Then
 If (ws.Name <> "2017_EXP") Then
 If (ws.Name <> "2018_WASTE_VOL") Then
 If (ws.Name <> "2017_WASTE_VOL") Then
 If (ws.Name <> "Presentation") Then
 If (ws.Name <> "DATASHEET") Then
 If (ws.Name <> "SITE PCC VIEW") Then
 
      ws.Select
    CostC = Range(Cells(1, 2), Cells(1, 2))
    Costype = ""
    For k = 1 To lr
     If CostC = looktbl(k, 4) Then
      ' Cost centre found
       Costype = looktbl(k, 9)
       Exit For
     End If
    Next k
   If firstt Then
    headers = Range(Cells(1, 1), Cells(4, 53))
    headers(1, 7) = "Cost Center Type"
    firstt = False
   End If
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    inarr = Range(Cells(5, 1), Cells(LastRow, 54))
    For i = 1 To LastRow - 4
     For j = 1 To 53
     retr = "r" & (4 + i) & "C" & j
     inarr(i, j + 1) = "=" & ws.Name & "!" & retr
     Next j
     ' put in the cost centre and cost type
     inarr(i, 1) = CostC
     inarr(i, 7) = Costype
    Next i
    Range(.Cells(indi, 1), .Cells(indi + LastRow - 5, 54)).Formula = inarr
    indi = indi + LastRow - 4
 End If
 End If
 End If
 End If
 End If
 End If
 End If
 End If
Next ws
 Range(.Cells(1, 2), .Cells(4, 54)) = headers
 Range(.Cells(1, 1), .Cells(1, 1)) = "Cost Center"




End With