Summary sheet created from multiple worksheets using a dynamic range - vba

Question

I have a 176 worksheets in a workbook, that all have the same format/structure, but are a difference size in row length.
I want to copy the data that is held in range A10:V(X) where X is a calculable number. This data will be pasted underneath each other, in columns B:W of the main sheet "RDBMergeSheet" and the name of the sheet that each row came from will be pasted into Column A of RDBMergeSheet so it can be seen which rows came from which sheets
X = (The lowest used row number in column J) - 3
If it makes it easier, another way to calculate X is find the row number in column A that contains the word "total" and subtract 1 from it.
The following link contains an example of such a sheet, with sanitised data.
https://imgur.com/a/emlZj
The code I've got so far, with help, is:
Sub ImportData()
Dim x As Long
Dim LR As Long
Dim wks As Worksheet
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
Set wks = Sheets("RDBMergeSheet"): If Not wks Is Nothing Then wks.Delete
Set wks = Worksheets.Add(after:=Worksheets(Sheets.Count))
wks.Name = "RDBMergeSheet"
For x = 1 To Worksheets.Count - 1
LR = Application.Max(1, Sheets(x).Cells(Rows.Count, 10).End(xlUp).Row - 3)
With wks.Cells(Rows.Count, 1)
.Offset(1, 1).Resize(LR, 22).Value = .Cells(1, 10).Resize(LR, 22).Value
.Offset(1).Resize(LR - 9).Value = Sheets(x).Name
End With
Next x
wks.Select
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
Set wks = Nothing
End Sub
This errors out with a 1004: Application defined or object defined error on line
.Offset(1, 1).Resize(LR, 22).Value = .Cells(1, 10).Resize(LR, 22).Value
If anyone has any ideas on either how to resolve this I would be extremely grateful.

Answer 1

Please give this a try and tweak it as per your requirement to make sure the correct data is copied starting from the correct row on destination sheet.
Sub ImportData()
Dim LR As Long, dLR As Long, i As Long
Dim wks As Worksheet
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
On Error Resume Next
Set wks = Sheets("RDBMergeSheet")
wks.Cells.Clear
On Error GoTo 0
If wks Is Nothing Then
Set wks = Worksheets.Add(after:=Worksheets(Sheets.Count))
wks.Name = "RDBMergeSheet"
End If
For i = 1 To Worksheets.Count - 1
If Worksheets(i).Name <> wks.Name Then
LR = Application.Max(1, Sheets(i).Cells(Rows.Count, 10).End(xlUp).Row - 3)
If LR > 9 Then
If wks.Range("B1").Value = "" Then
dLR = 1
Else
dLR = wks.UsedRange.Rows.Count + 1
End If
wks.Range("B" & dLR & ":X" & LR - 9).Value = Worksheets(i).Range("B10:X" & LR).Value
wks.Range("A" & dLR).Value = Worksheets(i).Name
End If
End If
Next i
On Error Resume Next
wks.Select
dLR = wks.UsedRange.Rows.Count
wks.Range("A1:A" & dLR).SpecialCells(xlCellTypeBlanks).Formula = "=R[-1]C"
wks.Range("A1:A" & dLR).Value = wks.Range("A1:A" & dLR).Value
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
Set wks = Nothing
End Sub