Excel VBA-将数据从一个文件拉到另一个文件

我正在尝试创建一个VBA脚本，该脚本进入文件1并将数据复制到文件2中。文件1包含数据

我遇到的问题是file2有更多的列，并且不一定与file1中的列的顺序相同。另外，范围是错误的，我不确定如何选择所有相关数据。如何确保它在file1中获得每列的所有相关行

Sub GetDatacClosedBook()

Dim src As Workbook
Set src = Workbooks.Open("C:\Users\Data\Documents\File1", True, True)
Set wbOpen = ActiveWorkbook

'this is the workbook in which the data will be transferred to
Workbooks.Open "C:\Users\Data\Documents\file2.xlsx"

Worksheets("Sheet1").Range("A1:D3").Formula = src.Worksheets("Sheet1").Range("A1:D3").Formula
wbOpen.Close

End Sub

---

您应该首先确定数据表中的列与目标表中的哪些列相匹配。然后一切都应该很容易。这可以通过多种方式实现。我假设您的A行有标题，那么您可以通过匹配标题来匹配列

Sub Macro()
    Dim destSht As Worksheet, srcSht As Worksheet
    Dim src_ColCnt As Integer, dest_ColCnt As Integer
    
    'Open the workbooks and grab the sheet reference, assign it to a worksheet variables
    Set srcSht = Workbooks.Open("D:\data.xlsx").Sheets("Sheet1")
    Set destSht = Workbooks.Open("D:\report.xlsx").Sheets("Sheet1")
    
    'Find how many columns in your destination sheet, how many columns in your source sheet and how many rows the source sheet data has.
    dest_ColCnt = destSht.Range("A1").End(xlToRight).Column
    src_ColCnt = srcSht.Range("A1").End(xlToRight).Column
    src_RCnt = srcSht.Range("A1").End(xlDown).Row - 1
    
    
    'The code below is basically loop over the source sheet headers, and for each header
    'find the column in your destination that has the same header
    'And then assign the data row by row once it knows which column in the data sheet go to which column in the destination sheet
    For i = 1 To src_ColCnt
        Header = srcSht.Cells(1, i)
        For j = 1 To dest_ColCnt
            If destSht.Cells(1, j).Value = Header Then
                For r = 1 To src_RCnt
                    'Do your assignment here row by row
                    'You can assign formula, value or different thing based on your requirement
                    'I assume your data start from the second row here
                    destSht.Cells(r + 1, j).Value = srcSht.Cells(r + 1, i).Value
                Next r
            End If
        Next j
    Next i
End Sub

---

这并不优雅，但应该给你一个想法。为了使以上内容更加优雅，您可以使用以下几种方法。一种是使用

Scripting.Dictionary

数据结构来保存字典中的标题作为键，列序号作为值。然后逐列循环目标工作表。从字典中检索右列序号。第二，您可以使用

工作表functions.Match（）

查找序号。如果你自己知道顺序，那就更好了。您只需硬编码一个顺序数组，如

mapOrder=Array（3,1,5,6）

，然后使用此数组匹配列。

您可以编写一个函数，指向特定工作簿，定位列（可能通过标题），并将该列数据捕获到该函数返回的数组中。 然后按所需顺序将数组写入另一张纸

子程序和函数的示例：

Private Sub GetDatacClosedBook()

Dim ExampleArray As Variant
Dim Destination As Range

    ExampleArray = LocateColumnReturnArray(ThisWorkbook.Sheets("Sheet1"), "Value to find in row1 of the desired column")
    
    
    Set Destination = ThisWorkbook.Sheets("Sheet2").Range("A1")
    Destination.Resize(UBound(ExampleArray), 1) = ExampleArray

End Sub

您可以将这个概念应用到您的需求中。 此函数可以根据需要为每个要获取数据的列运行任意多次。

---

您还需要为每一列数据指定目标，但您可以修改上述内容，以便根据您的数据写入的列使用循环。

您好，我将此代码存储在我的个人工作簿中。我想知道在您的代码中，我将在哪里标识File1和File2路径（因为它与我的个人工作簿不同）？或者这段代码将如何调用不同的工作簿？以及“在此处逐行执行作业”是什么意思。对不起，我是新来的VBA@AK对不起，我刚在我的代码片段中发现一个拼写错误，我已经更正了。至于你的问题，你可以像你做的那样使用文件路径。请记住，“workbooks.open”方法将返回新打开工作簿的引用。因此，您可以使用工作簿引用查找工作表引用。我将修改代码段，以便您可以看到我的意思。我按原样运行，没有对赋值部分进行任何更改，但在“destSht.Range（r+1，j）.Value=srcSht.Range（r+1，I）.Value”处失败。它显示运行时错误1004。对象“工作表”的方法“范围”failed@AK嗨，我刚修改了密码。您可以使用''.Cells（行、列）而不是.Range（）''，很抱歉出现错误。我只是想给你一个想法，所以只是简单地起草一些东西，而不是真正去测试它。但是这个版本你应该可以开箱即用。记住修改代码以适应您自己的场景，如文件路径。

Public Function LocateColumnReturnArray(ByRef TargetWorksheet As Worksheet, ByVal TargetColumnHeader As String) As Variant

Dim LastUsedColumn As Long
Dim TargetCell As Range

    With TargetWorksheet
        LastUsedColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
        
        For Each TargetCell In .Range(.Cells(1, 1), .Cells(1, LastUsedColumn))
            If TargetCell.Value = TargetColumnHeader Then
                LastUsedRow = .Cells(.Rows.Count, LastUsedColumn).End(xlUp).Row
                LocateColumnReturnArray = .Range(.Cells(2, TargetCell.Column), .Cells(LastUsedRow, TargetCell.Column))
                Exit Function
            End If
        Next TargetCell
    End With
End Function