Скопируйте диапазон с листа, просмотрите файлы в каталоге и выполните следующие действия. Добавьте строки на конкретный лист и вставьте значения в лист.

Question

Мне нужно скопировать данные с одного листа на моем рабочем столе и вставить их в каждый файл xlsx в указанной папке.Проблема, с которой я сталкиваюсь, заключается в бесконечном цикле копирования / вставки строк.

paste_value - это значение, которое будет вставлено в указанный диапазон на указанном листе «Exhibit 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