Início / user-30095271

ferociablejbear's questions

Martin Hope
ferociablejbear
Asked: 2025-03-29 02:05:39 +0800 CST
  • 6

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