Excel VBA从各种工作簿的各种单元格复制

在VBA Excel中需要一些帮助编码。 所以目前，我有100多个表格，必须从每个区域的许多单独的Excel文件中手动input所有数据到每个表格。 您可以在这里查看表格图像： https : //i.stack.imgur.com/ftLdE.png

我目前的代码仍然依赖于定位一个单元格范围的副本，这是不可行的考虑是否有改变的行/列。

是否有集体从每个地区的Excel文件中获取所有数据并插入？

或者是否可以定位一个标题或表名，以便它可以自动填写？ 如果解决方法如此简单并且之前被问过，请原谅我。

十分感谢你的帮助。

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

当然。 只要你知道起点，你可以dynamic地计数和复制行，看下面代码的修改：

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

在那里我把Cells(Rows.Count,14) ，14涉及列N.

其余的应用相同的逻辑，你应该没问题！ 让我知道这是如何工作，因为我没有testing它:)

Answer 2

我认为我们也有错误的方向。 我如何把代码倒过来？ 例如，源应该来自源文件的行C19：N19，并且要被复制到目标文件的行C14：N14。

 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