Runtime 9 Ошибка при добавлении листов из списка файлов

Question

У меня в настоящее время возникают трудности с кодом Excel VBA, моя проблема возникает при добавлении листов в книгу при переходе через некоторый код.

Dim DFWB As Workbook  'Dailyfeed Workbook 
    Dim NewWb As Workbook  'New Data sheet for all linked Ip addresess 
    Dim DataWb As Workbook 
    Dim NewWbs As Worksheet 
    Dim rtable As Range, Flist As Worksheet 


    Set DFWB = ThisWorkbook 
    Set Flist = DFWB.Worksheets("File List") 

    'Open New Workbook for data 
    Set NewWb = Workbooks.Add(Template:=xlWBATWorksheet) 

    For i = 2 To Flist.Cells(Rows.Count, 1).End(xlUp).Row 


     thisfile = Flist.Cells(i, 1) 
     If thisfile = "" Then Exit For 
     Set DataWb = Workbooks.Open(Filename:=thisfile) 
     DFWB.Activate 
     DR = ActiveCell.Value 
     DataWb.Activate 
     Set DataWbs = ActiveSheet 
     DataWbs.Activate 
     If ActiveSheet.AutoFilterMode Then 
    If ActiveSheet.FilterMode Then 
     ActiveSheet.ShowAllData 
    End If 
    End If 
    'Get data from DataWbs Worksheet 
     DataWbs.Range("A1").AutoFilter Field:=WorksheetFunction.Match("IPAddr", DataWbs.Range("1:1"), 0), Criteria1:=DR, Operator:= _ 
     xlAnd 
     Set rtable = DataWbs.Range("A1").CurrentRegion 
     NewWb.Sheets.Add After:=Sheets(NewWb.Sheets.Count) 
     Set NewWbs = NewWb.Worksheets(NewWb.Sheets.Count) 
     NewWbs.Cells(1, 4).Value = thisfile 
     NewWbs.Cells(1, 3).Value = "IP Data From File" 
     rtable.Copy Destination:=NewWbs.Cells(3, 1) 
     With NewWbs.Range("C1:D1").Font 
      .FontStyle = "Bold" 
      .Size = 16 
     End With 
     NewWbs.Columns(1).ColumnWidth = 18 
     NewWbs.Columns(2).ColumnWidth = 14 
     NewWbs.Columns(3).ColumnWidth = 30 

     DataWb.Activate 
    If ActiveSheet.AutoFilterMode Then 
    If ActiveSheet.FilterMode Then 
     ActiveSheet.ShowAllData 
    End If 
    End If 
    ActiveWorkbook.Close Savechanges:=False 

    Next i 
    NewWb.Activate 
    Application.DisplayAlerts = False 
    ActiveWorkbook.Sheets("Sheet1").Delete 
    Application.DisplayAlerts = True 
    NewWb.Worksheets(1).Activate 

    End Sub 

Я получаю ошибку времени выполнения 9 в следующей строке кода, которая добавляет новый новый лист.

 NewWb.Sheets.Add After:=Sheets(NewWb.Sheets.Count) 
    Set NewWbs = NewWb.Worksheets(NewWb.Sheets.Count) 

Мой код работает для 1-го двух файлов в моем списке, но не более того, есть ли у кого-нибудь идеи.

Answer 1

Утро,

Ошибка возникает при попытке добавить 3-ий рабочий лист, чтобы принять скопированные данные. Ошибка возникает с ошибкой времени выполнения «индекс вне диапазона» 9

Имеет ли факт, что он работает дважды, при отладке он открывает книгу данных, идентифицирует данные и выбирает диапазон. Он просто не добавит новый лист для вставки данных.

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