Excel VBA Copying from Various cells from various Workbooks

Question

Need some help coding in VBA Excel. So currently, I have 100+ tables and have to manually input all the data to each table from many separate Excel file from each region. You can view the table image here: https://i.stack.imgur.com/ftLdE.png

My current code still depends on targeting a range of cells to copy which is not feasible considering if there is a change in the rows/columns.

Is there anyway to collectively get all the data from each region's Excel file and insert it?

Or is it possible to target a header or a table name so that it can fill in automatically? Pardon me if the solution is so simple and have been asked before.

Thank you so much for the help.

Sub Extract()
Dim x As Workbook
Dim y As Workbook
Dim OpenSource As String
Dim OpenTarget As String
OpenSource = Application.GetOpenFilename("File Type, *.xlsm")
If OpenSource = "False" Then Exit Sub
OpenTarget = Application.GetOpenFilename("File Type, *.xlsm")
If OpenTarget = "False" Then Exit Sub
'## Open both workbooks first:

Set x = Workbooks.Open(OpenSource) 'Source File 'thisworkbook can implement here?
Set y = Workbooks.Open(OpenTarget) 'Destination File

'Now, transfer values from x to y:
y.Sheets("Data").Range("C16:N16").Value = x.Sheets("Data").Range("C19:N19").Value
y.Sheets("Data").Range("C34:N34").Value = x.Sheets("Data").Range("C37:N37").Value
y.Sheets("Data").Range("C52:N52").Value = x.Sheets("Data").Range("C55:N55").Value
y.Sheets("Data").Range("C70:N70").Value = x.Sheets("Data").Range("C73:N73").Value
y.Sheets("Data").Range("C124:N124").Value = x.Sheets("Data").Range("C127:N127").Value
y.Sheets("Data").Range("C286:N286").Value = x.Sheets("Data").Range("C289:N289").Value

y.Sheets("Data").Range("R88:AC88").Value = x.Sheets("Data").Range("R91:AC91").Value
y.Sheets("Data").Range("R106:AC106").Value = x.Sheets("Data").Range("R109:AC109").Value
y.Sheets("Data").Range("R142:AC142").Value = x.Sheets("Data").Range("R145:AC145").Value
y.Sheets("Data").Range("R160:AC160").Value = x.Sheets("Data").Range("R163:AC163").Value
y.Sheets("Data").Range("R178:AC178").Value = x.Sheets("Data").Range("R181:AC181").Value
y.Sheets("Data").Range("R196:AC196").Value = x.Sheets("Data").Range("R199:AC199").Value
y.Sheets("Data").Range("R214:AC214").Value = x.Sheets("Data").Range("R217:AC217").Value
y.Sheets("Data").Range("R232:AC232").Value = x.Sheets("Data").Range("R235:AC235").Value
y.Sheets("Data").Range("R250:AC250").Value = x.Sheets("Data").Range("R253:AC253").Value
y.Sheets("Data").Range("R268:AC268").Value = x.Sheets("Data").Range("R271:AC271").Value

y.Sheets("Data").Range("AG88:AR88").Value = x.Sheets("Data").Range("AG91:AR91").Value
y.Sheets("Data").Range("AG106:AR106").Value = x.Sheets("Data").Range("A109:AR109").Value
y.Sheets("Data").Range("AG142:AR142").Value = x.Sheets("Data").Range("AG145:AR145").Value
y.Sheets("Data").Range("AG160:AR160").Value = x.Sheets("Data").Range("AG163:AR163").Value
y.Sheets("Data").Range("AG178:AR178").Value = x.Sheets("Data").Range("AG181:AR181").Value
y.Sheets("Data").Range("AG196:AR196").Value = x.Sheets("Data").Range("AG199:AR199").Value
y.Sheets("Data").Range("AG214:AR214").Value = x.Sheets("Data").Range("AG217:AR217").Value
y.Sheets("Data").Range("AG232:AR232").Value = x.Sheets("Data").Range("AG235:AR235").Value
y.Sheets("Data").Range("AG250:AR250").Value = x.Sheets("Data").Range("AG253:AR253").Value
y.Sheets("Data").Range("AG268:AR268").Value = x.Sheets("Data").Range("AG271:AR271").Value


MsgBox ("Done")
End Sub

Answer 1

Sure. as long as you know the starting point, you can dynamically count and copy rows, see modification to code below:

x.Sheets("Data").Range("C16:N" & Cells(Rows.Count, 14).End(xlUp).Row).Copy Destination:=y.Sheets("Data").Range("C19")

where i have put Cells(Rows.Count,14) , the 14 relates to column N.

Apply the same logic to the rest and you should be fine! let me know how this works as i have not tested it :)

Answer 2

I think we have the Destination and Source the wrong way around as well. How do I put the code in reverse? Eg The source should be from row C19:N19 of the source file and to be copied to row C14:N14 of the destination file.

Sub Extract()
Dim x As Workbook
Dim y As Workbook
Dim OpenSource As String
Dim OpenTarget As String
OpenSource = Application.GetOpenFilename("File Type, *.xlsm")
If OpenSource = "False" Then Exit Sub
OpenTarget = Application.GetOpenFilename("File Type, *.xlsm")
If OpenTarget = "False" Then Exit Sub


Set x = Workbooks.Open(OpenSource) 'Source File
Set y = Workbooks.Open(OpenTarget) 'Destination File

x.Sheets("Data").Range("C14:N" & Cells(Rows.Count, 14).End(xlUp).Row).Copy Destination:=y.Sheets("Data").Range("C19")

MsgBox ("Done")
End Sub