Question

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

我一直在修改我在本网站上找到的代码，用它来复制特定格式的特定数据。我需要一些指导是添加一个循环来从将放入文件夹的文件中获取数据。Files that needed to be read

所以我的问题

基本上，我已经设置了需要复制并粘贴到目标文件的特定数据范围。但是，有没有办法放置一个循环，它会自动跳转到下一个工作簿并获取这些值？
我发现使用这种方法传输数据时，它不传输数据性质，例如，如果它是时间格式的源文件，当VBA执行并更新目标文件时，该值的格式不同，并且都以一般格式粘贴。
是否可以将更新循环到自动跳转到下一行以粘贴数据？

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

感谢您的经验输入。

Answer 1

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

这将帮助您入门

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执行并更新目标文件时， value的格式不同，并且所有格式都以一般格式粘贴。

代码直接设置值，因此不会复制格式。您需要.Copy和.Pastespecial，而不是直接设置值。录制一个宏，了解.Copy和.Pastespecial的工作原理。或阅读

Range.PasteSpecial Method (Excel)

3）是否可以将更新循环到自动跳转到下一行以粘贴数据？

找到最后一行，然后对该行执行复制粘贴。请参阅以下链接以查找最后一行。

Finding Last Row

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

循环

End Sub

亲爱的@SiddharthRout，进入循环并运行宏后，没有任何反应。也许我错过了代码中的一些东西？

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

2 个答案: