admin 管理员组

文章数量: 1086019

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

• excel
• vba

Share Improve this question Follow edited Mar 28 at 18:42 ferociablejbear asked Mar 28 at 18:05 ferociablejbearferociablejbear 1311 silver badge33 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

Sorted by: 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.

本文标签： excelSubscript out of range error when replacing ThisWorkbookActivate with wbActivateStack Overflow