從各種工作簿的各個單元格復制Excel VBA

Question

需要一些在VBA Excel中編碼的幫助。 因此，目前，我有100多個表，並且必須從每個區域的許多單獨的Excel文件中將所有數據手動輸入到每個表中。 您可以在此處查看表格圖像： 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

當然。 只要您知道起點，就可以動態計數和復制行，請參見下面的代碼修改：

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列有關。

將相同的邏輯應用於其余部分，就可以了！ 讓我知道它是如何工作的，因為我還沒有測試過:)

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