運行時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) 

我的代碼適用於列表中的前兩個文件，但沒有更多，沒有任何人有任何想法。

Answer 1

上午，

錯誤嘗試添加第三個工作表，以接受複製數據時發生。錯誤出現「下標超出範圍」運行時錯誤9

它調用它兩次，當調試打開數據工作簿，識別數據，選擇範圍的事實。它不會添加新的工作表來粘貼數據。

可以通過這種方式來獲得Filelist變量計數列表中的文件數，然後將正確的數字添加到新的工作簿中，然後使用循環在表單中複製和粘貼數據。