Индекс выходит за пределы допустимого диапазона после секунды l oop до

Question

• 1000 следующее имя файла в списке. В настоящее время код работает через первые два цикла, но затем застревает в «Workbooks (fname) .Activate» в приведенном ниже коде. Я понял, что ошибка возникает из-за ActiveCell.Offset, когда он проходит через второй l oop, но я не могу понять, почему он будет работать для первых двух, а затем просто остановится. Любая помощь приветствуется!

Sub x1853_Get_ALL_Dim3()

    Dim fname As String
    Dim Name As String
    Dim Path As String
    Dim Path2 As String
    
    Sheets("Sheet1").Select
    
    Range("A6").Select
    
    Do Until ActiveCell.Value = ""
    
    fname = Path2 & ActiveCell.Value
    
      Path = ThisWorkbook.Path
     Path2 = Path & "\Pull\"
    ChDrive Path2
    ChDir Path2
    
   Name = ThisWorkbook.Name
    
 Application.ScreenUpdating = False
    
    Workbooks.Open Filename:=fname, Local:=True
    ActiveWindow.SmallScroll Down:=0
    Range("B3:B300").Select
    ActiveWindow.SmallScroll Down:=-15
    Selection.Copy
    
    Workbooks(Name).Activate
    ActiveCell.Offset(0, 2).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Workbooks(fname).Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close SaveChanges:=False
    ActiveCell.Offset(0, -2).Range("A1").Select
    
    ActiveCell.Offset(1, 0).Select
    
    Loop
      
Application.ScreenUpdating = True
End Sub

Answer 1

Workbooks.Open возвращает ссылку на книгу, которую вы должны записать. Измените:

Workbooks.Open Filename:=fname, Local:=True

на

Dim wb As Workbook
Set wb = Workbooks.Open(Filename:=fname, Local:=True)

, а затем обратитесь к wb вместо Workbooks(fname).

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