如何使VBA代码运行特定的Excel文件?

我很难find这个错误:我想要做的就是使这个代码在Book1.xls的Sheet1上运行,即使我在其他Excel文件或其他工作表中工作。 所有的代码的第一部分工作正常,直到**线,但之后,当我在一个不同的页面或文件“呛”,并给我一个错误。

Sub Upload0() ' Upload Webpage content Application.OnTime Now + TimeValue("00:00:10"), "Upload0" With Workbooks("Book1.xls").Sheets("Sheet1").QueryTables.Add(Connection:= _ "URL;http://cetatenie.just.ro/ordine/articol-11", Destination:=Workbooks("Book1.xls").Sheets("Sheet1").Range("A1")) .Name = "CetatenieOrdine" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = True .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = True .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlEntirePage .WebFormatting = xlWebFormattingNone .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With ' Deletes Empty Cells Workbooks("Book1.xls").Sheets("Sheet1").Range("A1").Columns("A:A").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp ****************************************************************************** ' Deletes useless Rows and fits the Width Rows("1:31").Select Selection.Delete Shift:=xlUp Range("B28").Select Selection.End(xlDown).Select Rows("17:309").Select Selection.Delete Shift:=xlUp ' Text to Column function with auto-confirmation to overwrite Columns("A:A").Select Application.DisplayAlerts = False Selection.TextToColumns Destination:=Columns("A:A"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ :=":", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True Application.DisplayAlerts = True Columns("B:B").Select Application.DisplayAlerts = False Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=True, Other:=False, OtherChar _ :=":", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _ TrailingMinusNumbers:=True Application.DisplayAlerts = True Columns("B:B").Select Selection.Delete Shift:=xlToLeft ' fit the Width of All Columns Cells.Select Range("A37").Activate Cells.EntireColumn.AutoFit Range("H1").Select Rows("1:1").Select Selection.Font.bold = True End Sub 

在不指定工作表的情况下访问RowsRange ,VBA使用ActiveSheet。 在这种情况下,您应该明确指定您要使用的工作表:

 Sub Upload0() ' Upload Webpage content Application.OnTime Now + TimeValue("00:00:10"), "Upload0" With Workbooks("Book1.xls").Sheets("Sheet1").QueryTables.Add(Connection:= _ "URL;http://cetatenie.just.ro/ordine/articol-11", Destination:=Workbooks("Book1.xls").Sheets("Sheet1").Range("A1")) .Name = "CetatenieOrdine" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = True .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = True .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlEntirePage .WebFormatting = xlWebFormattingNone .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With ' Deletes Empty Cells Workbooks("Book1.xls").Sheets("Sheet1").Range("A1").Columns("A:A").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp ****************************************************************************** With Workbooks("Book1.xls").Sheets("Sheet1") ' Deletes useless Rows and fits the Width .Rows("1:31").Delete Shift:=xlUp .Rows("17:309").Delete Shift:=xlUp ' Text to Column function with auto-confirmation to overwrite Application.DisplayAlerts = False .Columns("A:A").TextToColumns Destination:=Columns("A:A"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ :=":", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True .Columns("B:B").TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=True, Other:=False, OtherChar _ :=":", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _ TrailingMinusNumbers:=True Application.DisplayAlerts = True .Columns("B:B").Delete Shift:=xlToLeft ' fit the Width of All Columns .Cells.EntireColumn.AutoFit .Rows("1:1").Font.bold = True End With End Sub