Início / coding / Perguntas / 79542137
Accepted
ferociablejbear
Asked: 2025-03-29 02:05:39 +0800 CST

Erro de subscrito fora do intervalo ao substituir ThisWorkbook.Activate por wb.Activate

  • 772

Sou muito novo em VBA, então essa é provavelmente uma pergunta simples de responder, mas não consegui encontrá-la enquanto pesquisava no Google. Tenho um Sub que está funcionando bem quando uso ThisWorkbook.Activate, mas se recusa a executar se eu o substituir por uma referência direta à pasta de trabalho, e não consigo descobrir o porquê.

Informações da versão: Microsoft® Excel® para Microsoft 365 MSO (versão 2501 Build 16.0.18429.20132) 64 bits

Código não funcional

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.com\tgtFile.xlsx"
    srcFilePath = "https://org-my.sharepoint.com/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

Código de trabalho

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.com\tgtFile.xlsx"
    srcFilePath = "https://org-my.sharepoint.com/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

1 respostas

  1. Best Answer

    Supondo que você esteja recebendo "Erro de tempo de execução 9 (Subscrito fora do intervalo)", o problema é sua referência à pasta de trabalho de origem.

    Set srcWB = Workbooks(srcFilePath)

    A linha acima não funciona porque Workbooks()é uma "coleção que representa todas as pastas de trabalho abertas". Como uma função chamável, ela espera um nome de arquivo (incluindo a extensão se o arquivo foi salvo anteriormente) ou um número de índice para a pasta de trabalho aberta correta — não um caminho de arquivo. Veja a documentação .

    Solução

    Para a pasta de trabalho que chama a macro, use um dos seguintes:

    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

    Para outras pastas de trabalho, abrir e definir suas referências como você fez funciona bem

    Set WB_Data = Workbooks.Open(path_to_data_WB)

    Se todas as pastas de trabalho estiverem abertas e suas referências definidas corretamente, srcWB.Activatedeve funcionar bem.

    • 1

relate perguntas