☰

Excel Transpor entre arquivos com VBA

tag-icon • tag-icon microsoft-excel vba microsoft-excel-2016
Excel Transpor entre arquivos com VBA

Preciso transpor entre arquivos, mas estou travado? Quando transponho dentro de apenas um arquivo, meu código funciona. Mas quando tentei transpor para outro arquivo, isso não aconteceu. Minha sintaxe está obviamente com defeito.

Tenho 80 pesquisas com clientes que espero transpor para apenas uma.

Meu código que funciona é:

Sub Trans2()
    Range("C14:C21").Select
    Selection.Copy
    Range("G6").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                           False, Transpose:=True
End Sub

Mas quando tento executá-lo de uma pasta de trabalho e transpor para outra, ele falha.

Meu código "quebrado" é:

Sub TransposeInfo()
    '
    ' Transpose info between files
    '
    Dim mySource As String
    Dim myDest As String
    Dim wbkWorkbook1 As Workbook
    Dim wbkWorkbook2 As Workbook

    'Define path and filename
    mySource = "C:\2018\CustSvy001.xls*"
    myDest = "C:\2018\CustResults.xlsx"

    'Open files
    Set wbkWorkbook1 = Workbooks.Open(mySource)
    Set wbkWorkbook2 = Workbooks.Open(myDest)

    'Select items to transpose
    wbkWorkbook1.Worksheets("Q8").Range("B8:B11").Select
    Selection.Copy
    wbkWorkbook2.Worksheets("New").Range("G6").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                           False, Transpose:=True

    'Close the two workbooks
    wbkWorkbook1.Close (True)
    wbkWorkbook2.Close (True)
End Sub

Alguma sugestão? Sou muito iniciante em VBA, então, quanto menos complicado, melhor.

Responder1

Se você estiver recebendo este erro:

Mensagem de erro

é por causa do *nome do arquivo - substitua-o pela letra exata do nome do arquivo

.

Experimente isto:

Public Sub TransposeInfoBetweenFiles()
    Dim mySource As String
    Dim myDest As String
    Dim wbkWorkbook1 As Workbook
    Dim wbkWorkbook2 As Workbook

    'Define path and filename
    mySource = "C:\2018\CustSvy001.xlsx" '<- Replaced "*" with "x" or "m"
    myDest = "C:\2018\CustResults.xlsx"  '<- This is Ok (exact path and file name)

    Application.ScreenUpdating = False

    'Open files
    Set wbkWorkbook1 = Workbooks.Open(mySource)
    Set wbkWorkbook2 = Workbooks.Open(myDest)

    'Select items to transpose
    wbkWorkbook1.Worksheets("Q8").Range("B8:B11").Copy
    wbkWorkbook2.Worksheets("New").Range("G6").PasteSpecial Paste:=xlPasteAll, _
                                               SkipBlanks:=False, Transpose:=True
    'Close the two workbooks
    wbkWorkbook1.Close True
    wbkWorkbook2.Close True

    Application.ScreenUpdating = True
End Sub

informação relacionada