Question

我需要从桌面上的一张纸上复制数据，并将其粘贴到指定文件夹中的每个xlsx文件中。我遇到的问题是复制粘贴/添加行的无尽循环。

paste_value是要粘贴在指定工作表“图表1d”中指定范围内的值

下面是代码

Sub loopFile()
Dim Filename, Pathname As String
Dim wb As Workbook
Dim paste_value As String


paste_value = Workbooks("copy_file.xlsx").Worksheets("EXHIBIT 1D").Range("B59:C64").Copy
Pathname = "C:\Users\GP8535\Desktop\loop_folder\"
Filename = Dir(Pathname & "\*.xls*")
Do While Filename <> ""
Application.DisplayAlerts = False
Application.ScreenUpdating = False

    paste_value = Workbooks("copy_file.xlsx").Worksheets("EXHIBIT 1D").Range("B59:C64").Copy
    Set wb = Workbooks.Open(Pathname & Filename)

    wb.Worksheets("EXHIBIT 1D").Rows("57:63").EntireRow.Insert
    wb.Worksheets("EXHIBIT 1D").Range("B59:C63").PasteSpecial


    wb.Close SaveChanges:=True


Loop


End Sub

Answer 1

尝试一下。一些问题

您用于定义paste_value的语法是错误的；我认为最好定义范围（使用Set），并在循环外进行，因为它不会改变
循环遍历文件的关键是循环的最后一行；您的代码每次都会打开相同的工作簿

别忘了最后打开警报并重新更新

Sub loopFile()

Dim Filename, Pathname As String
Dim wb As Workbook
Dim paste_value As Range

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Pathname = "C:\Users\GP8535\Desktop\loop_folder\"
Filename = Dir(Pathname & "\*.xls*")
Set paste_value = Workbooks("copy_file.xlsx").Worksheets("EXHIBIT 1D").Range("B59:C64")

Do While Filename <> ""
   Set wb = Workbooks.Open(Pathname & Filename)
   wb.Worksheets("EXHIBIT 1D").Rows("57:63").EntireRow.Insert
   paste_value.Copy wb.Worksheets("EXHIBIT 1D").Range("B59:C63")
   wb.Close SaveChanges:=True
   Filename = Dir
Loop

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

从工作表复制范围，并循环浏览目录中的文件，然后执行以下操作：将行添加到特定工作表，然后将值粘贴到工作表

1 个答案: