Question

目前，我有一项任务要求我通过点击按钮从特定文件夹中的多个Excel文件传输（复制和粘贴）并更新主Excel文件中的任何现有数据。目前，我能够创建一个代码，允许我将数据从特定文件夹中的多个excel文件传输（复制和粘贴）到主excel文件，但它不会更新主excel文件中的任何现有数据。任何人都可以查看我的代码并帮助我创建一个代码，通过单击按钮从特定文件夹中的多个excel文件传输和更新主excel文件中的任何现有数据？非常感谢任何帮助，谢谢。

我目前的代码：

Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
Dim Filepath As String
Dim lr As Long
Filepath = "C:\Users\Joel\Desktop\MultiFileTesting\"
MyFile = Dir(Filepath)
Do While Len(MyFile) > 0
If MyFile = "TestingMaster.xlsm" Then
Exit Sub
End If

Workbooks.Open (Filepath & MyFile)
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy
Application.DisplayAlerts = False
'ActiveWorkbook.Close
ThisWorkbook.Activate

erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 11))

MyFile = Dir
Loop
End Sub

Answer 1

不明白这段代码究竟是什么问题，但让我们试一试。

1）您可能不希望在MyFile = TestingMaster.xlsm时结束整个脚本，只需跳过它。

2）您可能只想循环某些特定类型的文件，例如“xlsm”或“xlsx”

3）不知道你为什么使用Application.DisplayAlerts = False和ThisWorkbook.Activate

4）您需要存储“主”文件名才能使用Windows(mainName).Activate返回该文件名。我已将其分配给变量mainName = ActiveWorkbook.Name。

5）我不知道你的源文件的结构，但是你可能需要使用一些特定的工作表名称（Sheets("MySheet").）或它的位置（Sheets(1).）而不是{{1 }}

6）我建议使用ActiveSheet.代替PasteSpecial。您可以通过更改Paste

的xlPasteAll来仅粘贴值

7）您需要关闭源文件而不保存xlPasteValues。

此更改后的示例代码如下所示：

Workbooks(MyFile).Close False

Answer 2

<强> CODE

    Sub import_tickets()`

    "run this when the active file is the main ticket list and the active sheet is the ticket list"

    "exported file must be open already, and the ticket list must be the active sheet"

    Dim exported_file As String
    exported_file = "20150818_PDCA_Salwa-14-SENT.xlsx"
    header_exists = True 'if exported file doesn't have a header, set this to false!
    starting_row = 1
    If header_exists Then starting_row = 2`

    Dim first_blank_row As Long
    first_blank_row = Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row

    Dim r As Long
    r = starting_row
    Dim found As Range
    cur_ticket_num = Workbooks(exported_file).ActiveSheet.Range("a" & r).Value
    Do While Not cur_ticket_num = ""
        'look for current ticket number in main file
        Set found = Columns("a:a").Find(what:=cur_ticket_num, LookIn:=xlValues, lookat:=xlWhole)
        If found Is Nothing Then
            'add info to end of main file
            write_line_from_export exported_file, r, first_blank_row
            first_blank_row = first_blank_row + 1
        Else
            'overwrite existing line of main file
            write_line_from_export exported_file, r, found.Row
        End If
        r = r + 1
        cur_ticket_num = Workbooks(exported_file).ActiveSheet.Range("a" & r).Value
    Loop
End Sub

Sub write_line_from_export(src_filename As String, src_r As Long, dest_r As Long)
    For c = 1 To 24
        Cells(dest_r, c).Value = Workbooks(src_filename).ActiveSheet.Cells(src_r, c).Value
    Next c
End Sub

如何从多个excel文件传输和更新主excel文件中的现有数据

2 个答案: