Excel VBA将从不同的工作簿中获取特定的数据

Sub VBA_Read_External_Workbook() '''''Define Object for Target Workbook Dim Target_Workbook As Workbook Dim Source_Workbook As Workbook Dim Target_Path As String '''''Assign the Workbook File Name along with its Path '''''Change path of the Target File name Target_Path = "C:\Users\User\Desktop\Excel VBA\Working Sample Folder\MAY 2017 Summary- Atlas work.xlsx" Set Target_Workbook = Workbooks.Open(Target_Path) Set Source_Workbook = ThisWorkbook '''''With Target_Workbook object now, it is possible to pull any data from it '''''Read Data from Target File Target_Data = Target_Workbook.Sheets(1).Range("A1:B3") Source_Workbook.Sheets(2).Range("A1:B3") = Target_Data '''''Update Target File Source_data = Source_Workbook.Sheets(1).Range("A1:B3") Target_Workbook.Sheets(1).Range("A1:B3") = Source_data '''''Close Target Workbook Source_Workbook.Save Target_Workbook.Save Target_Workbook.Close False '''''Process Completed MsgBox "Task Completed" End Sub 

我一直在修改这个代码，我发现在这个网站上用它来复制特定格式的特定数据。 我需要的一些指导是添加一个循环来获取将放在一个文件夹中的文件的数据。 需要阅读的文件

所以我的问题

1. 基本上，我已经设置了需要复制的数据的特定范围并粘贴到目标文件上。 但不是不断改变目标path，有没有办法把一个循环，它会自动跳转到下一个工作簿，并获得这些值？

2. 我发现使用这种方法来传输数据，它不会传输数据性质，例如，如果它在源文件中是时间格式，当VBA执行和更新目标文件时，值不在相同的格式，全部以一般格式粘贴。

3. 是否有可能循环更新的地方，它会自动跳转到下一行粘贴数据？

我试图谷歌的一些VBA代码，但答案是非常模糊。

欣赏来自您的经验的任何input。

Answer 1

1）基本上，我已经设置了需要复制的数据的特定范围并粘贴到我的目标文件中。 但不是不断改变目标path，有没有办法把一个循环，它会自动跳转到下一个工作簿，并获得这些值？

这会让你开始

 Dim MyFolder As String Dim StrFile As String Dim flName As String '~~> Change this to the relevant folder MyFolder = "c:\MyFolder\" StrFile = Dir(MyFolder & "*.xls*") '~~> Loop through all excel files in the folder Do While Len(StrFile) > 0 flName = MyFolder & StrFile '~~> Open the workbook Set wb = Workbooks.Open(flName) ' '~~> Rest of your code ' wb.Close (False) StrFile = Dir Loop 

2）我发现使用这种方法传输数据，它不传递数据性质，例如，如果它是在源文件中的时间格式，当VBA执行和更新目标文件时，值不是采用相同的格式，全部以通用格式进行粘贴。

代码直接设置值，因此格式不被复制。 你需要.Copy和.Pastespecial而不是直接设置值。 logging一个macros，看看。 .Copy和.Pastespecial工作。 或阅读

Range.PasteSpecial方法（Excel）

3）是否有可能循环更新的地方，它会自动跳转到下一行粘贴数据？

find最后一行，然后复制粘贴到该行。 请看下面的链接find最后一行。

查找最后一行

Answer 2

Sub VBA_Read_External_Workbook（）

 '''''Define Object for Target Workbook Dim Target_Workbook As Workbook Dim Source_Workbook As Workbook Dim Target_Path As String Dim MyFolder As String Dim StrFile As String Dim flName As String '~~> Change this to the relevant folder MyFolder = "C:\Users\User\Desktop\Excel VBA\Working Sample Folder" StrFile = Dir(MyFolder & "*.xlsx*") '~~> Loop through all excel files in the folder Do While Len(StrFile) > 0 flName = MyFolder & StrFile '~~> Open the workbook Set wb = Workbooks.Open(flName) '''''Assign the Workbook File Name along with its Path '''''Change path of the Target File name Target_Path = "C:\Users\User\Desktop\Excel VBA\Working Sample Folder\Sample Source Files.xlsx" Set Target_Workbook = Workbooks.Open(Target_Path) Set Source_Workbook = ThisWorkbook '''''With Target_Workbook object now, it is possible to pull any data from it '''''Read Data from Target File Target_Data = Target_Workbook.Sheets(2).Range("A1:D10") '''''Target Paste range Source_Workbook.Sheets(1).Range("A1:D10") = Target_Data '''''Update Target File Source_data = Source_Workbook.Sheets(1).Range("A1:D10") Target_Workbook.Sheets(2).Range("A1:D10") = Source_data '''''Close Target Workbook Source_Workbook.Save Target_Workbook.Save Target_Workbook.Close False '''''Process Completed MsgBox "Task Completed" wb.Close (False) StrFile = Dir 

循环

结束小组

亲爱的@SiddharthRout，我进入循环并运行macros后，什么也没有发生。 也许我错过了代码中的东西？