Почему я получаю ошибку времени выполнения "1004" с кодом VBA для копирования и вставки из одной книги в другую?

Question

У меня проблемы с моим кодом VBA для моего макроса, который я хочу открыть msoFileDialogFolderPicker, и пользователь выбирает папку, в которой будут открыты все файлы Excel, и данные по одному будут скопированы из недавно открытой рабочей книги и вставлены в определенные листы в книге, где выполняется макрос. По сути, мы даем каждому нашему торговому представителю электронную таблицу для заполнения своих продаж, а затем они отправляют свои электронные таблицы менеджеру по продажам. Вместо того, чтобы открывать каждую электронную таблицу, копировать данные и вставлять все данные в одну электронную таблицу вручную, мне нужно просто создать макрос, который сделает это за меня. Поскольку расположение и имена файлов могут меняться, я стараюсь сделать его максимально динамичным. Там может быть лучший способ сделать это, поэтому любые предложения очень ценятся!

Проблема, с которой я сталкиваюсь, заключается в том, что я получаю файлы, которые открываются и они копируют, но затем я получаю ошибку времени выполнения 1004 "Метод копирования класса Range Failed", когда я пытаюсь вставить его в книгу, в которой выполняется макрос, Я пробовал ThisWorkbook и ThisWorkbook.Activate, чтобы попытаться указать Excel перейти в электронную таблицу, где выполняется макрос, но ни один из них не решил мою проблему. Иногда я получаю ошибку, но она все равно никогда не вставляет данные в основную рабочую книгу. У меня есть мой код, написанный ниже. По общему признанию, это было главным образом скопировано из кода, который я нашел, но я попытался приспособить это для моей цели. Строка, на которой я получаю сообщение об ошибке, - это строка "wb1.Worksheets(1).Range("A5").Select".

Sub LoopAllExcelFilesInFolder()

    Dim wb As Workbook
    Dim wb1 As Workbook
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String
    Dim FldrPicker As FileDialog

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

  With FldrPicker
    .Title = "Select A Target Folder"
    .AllowMultiSelect = False
      If .Show <> -1 Then GoTo NextCode
      myPath = .SelectedItems(1) & "\"
  End With


NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

myExtension = "*.xls*"

myFile = Dir(myPath & myExtension)

Do While myFile <> ""
  Set wb = Workbooks.Open(Filename:=myPath & myFile)
  Set wb1 = ThisWorkbook

  Do events

  wb.Worksheets(1).Range("A5:H28").Select
Selection.Copy
  wb1.Activate
  wb1.Worksheets(1).Range("A5").Select
  ActiveSheet.Paste

  DoEvents

  myFile = Dir
Loop

  MsgBox "Task Complete!"

ResetSettings:

  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True

End Sub

Это упрощенная версия того, что я в конечном итоге собираюсь сделать, которая включает в себя копирование объектов из нескольких рабочих листов во вновь открытой рабочей книге и вставка их в несколько листов изначально работающей в макро-режиме рабочей книги. На данный момент, однако, я просто пытаюсь заставить эту простую версию работать и работать. Спасибо всем за вашу помощь и мои извинения за длинный код, но я хочу дать всем представление о том, что именно я делаю. Спасибо!

Answer 1

Прекратить использование Select а также Activate и написание кода, который использует Selection - это для записи макросов. Вы не пишущий макрос, вы можете написать гораздо лучший код, чем этот.

Это делает слишком много вещей и заманивает вас в ловушку с запоздалыми связями, отрабатывающими ObjectЭто означает, что вы вводите код вслепую без помощи IntelliSense, без автозаполнения, без подсказок:

wb.Worksheets(1).Range("A5:H28").Select

Вы хотите Range возражать здесь

Dim source As Range
Set source = wb.Worksheets(1).Range("A5:H28")

Теперь, когда вы печатаете source.IntelliSense может помочь вам. Продолжай, попробуй:

source.Copy[space]

Обратите внимание на всплывающую подсказку о том, что вы можете указать пункт назначения тут же.

Итак, сделайте еще один диапазон:

Dim destination As Range
Set destination = wb1.Worksheets(1).Range("A5")

И скопируйте прочь!

source.Copy destination

Теперь вы, вероятно, должны позвонить wb.Close до конца этого цикла...