运行时9从文件列表添加工作表时出错

时间:2013-06-26 18:16:06

标签: excel-vba vba excel

我目前在使用某些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 个答案:

答案 0 :(得分:0)

上午,

尝试添加第3个工作表以接受复制的数据时发生错误。错误出现“下标超出范围”运行时错误9

它是否工作两次,在调试时打开数据工作簿,识别数据,选择范围。它不会添加新工作表来粘贴数据。

对于Filelist变量,可以采用一种方式计算列表中的文件数,然后将正确的数字表添加到新工作簿中,然后使用循环将数据复制并粘贴到工作表中。