最新消息:雨落星辰是一个专注网站SEO优化、网站SEO诊断、搜索引擎研究、网络营销推广、网站策划运营及站长类的自媒体原创博客

excel - Subscript out of range error when replacing ThisWorkbook.Activate with wb.Activate - Stack Overflow

programmeradmin1浏览0评论

I'm very new to VBA, so this is likely a simple question to answer, but I couldn't find it while googling. I have a Sub that is working fine when I use ThisWorkbook.Activate but refuses to run if I replace it with a direct reference to the workbook, and I can't figure out why.

Version info: Microsoft® Excel® for Microsoft 365 MSO (Version 2501 Build 16.0.18429.20132) 64-bit

Non-working code

Sub Paste_Columns()

 Application.ScreenUpdating = False
 Application.EnableEvents = False
 Application.DisplayAlerts = False
 Application.Calculation = xlCalculationManual
    
    Dim tgtWB As Workbook
    Dim tgtFilePath As String
    Dim cell As Range
    Dim lastRow As Long
    Dim srcWB As Workbook
    Dim srcFilePath As String
    
    tgtFilePath = "\\location\tgtFile.xlsx"
    srcFilePath = ".xlsm"
    
    Set tgtWB = Workbooks.Open(tgtFilePath)
    Set srcWB = Workbooks(srcFilePath)
    
    srcWB.Activate
    
    Union(Range("Tbl1[[#Headers],[#Data],[Column3]]"), _
            Range("Tbl1[[#Headers],[#Data],[Column6]]"), _
            Range("Tbl1[[#Headers],[#Data],[Column8]]"), _
            Range("Tbl1[[#Headers],[#Data],[Column12]]")).Select
    Selection.Copy

    tgtWB.Worksheets(4).Activate
    Range("A1").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    
    Dim tbl As ListObject
    Dim rng As Range

    Set rng = Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))
    Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes)
    tbl.TableStyle = "TableStyleMedium2"
        

End Sub

Working code

Sub Paste_Columns()

 Application.ScreenUpdating = False
 Application.EnableEvents = False
 Application.DisplayAlerts = False
 Application.Calculation = xlCalculationManual
    
    Dim tgtWB As Workbook
    Dim tgtFilePath As String
    Dim cell As Range
    Dim lastRow As Long
    Dim srcWB As Workbook
    Dim srcFilePath As String
    
    tgtFilePath = "\\location\tgtFile.xlsx"
    srcFilePath = ".xlsm"
    
    Set tgtWB = Workbooks.Open(tgtFilePath)
    Set srcWB = Workbooks.Open(srcFilePath)
    
    ThisWorkbook.Activate
    
    Union(Range("Tbl1[[#Headers],[#Data],[Column3]]"), _
            Range("Tbl1[[#Headers],[#Data],[Column6]]"), _
            Range("Tbl1[[#Headers],[#Data],[Column8]]"), _
            Range("Tbl1[[#Headers],[#Data],[Column12]]")).Select
    Selection.Copy

    tgtWB.Worksheets(4).Activate
    Range("A1").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    
    Dim tbl As ListObject
    Dim rng As Range

    Set rng = Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))
    Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes)
    tbl.TableStyle = "TableStyleMedium2"
        

End Sub

I'm very new to VBA, so this is likely a simple question to answer, but I couldn't find it while googling. I have a Sub that is working fine when I use ThisWorkbook.Activate but refuses to run if I replace it with a direct reference to the workbook, and I can't figure out why.

Version info: Microsoft® Excel® for Microsoft 365 MSO (Version 2501 Build 16.0.18429.20132) 64-bit

Non-working code

Sub Paste_Columns()

 Application.ScreenUpdating = False
 Application.EnableEvents = False
 Application.DisplayAlerts = False
 Application.Calculation = xlCalculationManual
    
    Dim tgtWB As Workbook
    Dim tgtFilePath As String
    Dim cell As Range
    Dim lastRow As Long
    Dim srcWB As Workbook
    Dim srcFilePath As String
    
    tgtFilePath = "\\location\tgtFile.xlsx"
    srcFilePath = "https://-my.sharepoint/personal/Documents/Desktop/srcFile.xlsm"
    
    Set tgtWB = Workbooks.Open(tgtFilePath)
    Set srcWB = Workbooks(srcFilePath)
    
    srcWB.Activate
    
    Union(Range("Tbl1[[#Headers],[#Data],[Column3]]"), _
            Range("Tbl1[[#Headers],[#Data],[Column6]]"), _
            Range("Tbl1[[#Headers],[#Data],[Column8]]"), _
            Range("Tbl1[[#Headers],[#Data],[Column12]]")).Select
    Selection.Copy

    tgtWB.Worksheets(4).Activate
    Range("A1").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    
    Dim tbl As ListObject
    Dim rng As Range

    Set rng = Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))
    Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes)
    tbl.TableStyle = "TableStyleMedium2"
        

End Sub

Working code

Sub Paste_Columns()

 Application.ScreenUpdating = False
 Application.EnableEvents = False
 Application.DisplayAlerts = False
 Application.Calculation = xlCalculationManual
    
    Dim tgtWB As Workbook
    Dim tgtFilePath As String
    Dim cell As Range
    Dim lastRow As Long
    Dim srcWB As Workbook
    Dim srcFilePath As String
    
    tgtFilePath = "\\location\tgtFile.xlsx"
    srcFilePath = "https://-my.sharepoint/personal/Documents/Desktop/srcFile.xlsm"
    
    Set tgtWB = Workbooks.Open(tgtFilePath)
    Set srcWB = Workbooks.Open(srcFilePath)
    
    ThisWorkbook.Activate
    
    Union(Range("Tbl1[[#Headers],[#Data],[Column3]]"), _
            Range("Tbl1[[#Headers],[#Data],[Column6]]"), _
            Range("Tbl1[[#Headers],[#Data],[Column8]]"), _
            Range("Tbl1[[#Headers],[#Data],[Column12]]")).Select
    Selection.Copy

    tgtWB.Worksheets(4).Activate
    Range("A1").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    
    Dim tbl As ListObject
    Dim rng As Range

    Set rng = Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))
    Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes)
    tbl.TableStyle = "TableStyleMedium2"
        

End Sub
Share Improve this question edited Mar 28 at 18:42 ferociablejbear asked Mar 28 at 18:05 ferociablejbearferociablejbear 131 silver badge3 bronze badges 6
  • 1 Is srcWB.Activate the problem? How many workbooks are open in this case? You already have the macro workbook open, then you open two other workbooks? – Tim Williams Commented Mar 28 at 18:07
  • 1 And what version of Excel? Older versions had a problem when you try to use Workbooks.Open to open an already-open workbook. – Tim Williams Commented Mar 28 at 18:16
  • Let's say there are three files , File A, File B, and File C, where File A is the srcWB and File B is the tgtWB. In the original version, the Macro is running in File A and pasting into File B. In the new version, the Macro is running in File C, copying from File A, and pasting in File B. – ferociablejbear Commented Mar 28 at 18:20
  • There's no subscript in the line srcWb.Activate... so I can't see how that's the line throwing the error. – BigBen Commented Mar 28 at 18:21
  • Microsoft® Excel® for Microsoft 365 MSO (Version 2501 Build 16.0.18429.20132) 64-bit – ferociablejbear Commented Mar 28 at 18:22
 |  Show 1 more comment

1 Answer 1

Reset to default 1

Assuming you are receiving "Run-time error 9 (Subscript out of range)", the issue is your reference to the source workbook.

Set srcWB = Workbooks(srcFilePath)

The above line does not work because Workbooks() is a "collection that represents all the open workbooks". As a callable function, it is expecting a file name (including the extension if the file was previously saved) or an index number for the correct open workbook—not a file path. See documentation.

Solution

For the workbook calling the macro use one of the following:

Set WB_Macro = ThisWorkbook
Set WB_Macro = Workbooks("name_of_macro_workbook")
Set WB_Macro = Workbooks.Open(path_to_macro_WB)
Set WB_Macro = ActiveWorkbook ' Not ideal as the active WB changes

For other workbooks, opening and setting their reference as you did works fine

Set WB_Data = Workbooks.Open(path_to_data_WB)

If all workbooks are open and their references set properly, srcWB.Activate should work fine.

发布评论

评论列表(0)

  1. 暂无评论