我目前在使用某些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)
我的代码适用于我列表中的前两个文件但不再适用,有没有人有任何想法。
答案 0 :(得分:0)
上午,
尝试添加第3个工作表以接受复制的数据时发生错误。错误出现“下标超出范围”运行时错误9
它是否工作两次,在调试时打开数据工作簿,识别数据,选择范围。它不会添加新工作表来粘贴数据。
对于Filelist变量,可以采用一种方式计算列表中的文件数,然后将正确的数字表添加到新工作簿中,然后使用循环将数据复制并粘贴到工作表中。