특정 Excel 파일에 대해 VBA 코드를 실행하는 방법은 무엇입니까?

Question

오류를 찾는 데 문제가 있습니다. 내가하고 싶은 것은이 코드가 다른 Excel 파일이나이 파일의 다른 시트에서 작업 할 때에도 Book1.xls의 Sheet1에서만 실행되도록 만드는 것입니다. 코드의 처음 부분은 모두 **- 라인까지 작동하지만 이후에 다른 페이지 나 파일에있을 때 "오류"가 발생하고 오류가 발생합니다.

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 

Answer 1

당신이 시트를 지정하지 않고 Rows 또는 Range 액세스, 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