
¿Necesito transponer entre archivos pero estoy atascado? Cuando transpongo dentro de un solo archivo, mi código funciona. Pero cuando intenté transponerlo a otro archivo, no fue así. Obviamente mi sintaxis es defectuosa.
Tengo 80 encuestas a clientes que espero trasladar a una sola.
Mi código que funciona es:
Sub Trans2()
Range("C14:C21").Select
Selection.Copy
Range("G6").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Sub
Pero cuando intento ejecutarlo desde un libro de trabajo y transponerlo a otro, falla.
Mi código "roto" es:
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
¿Alguna sugerencia? Soy bastante verde en VBA, así que cuanto menos complicado, mejor.
Respuesta1
Si recibe este error:
se debe al *
nombre del archivo; reemplácelo con la letra exacta del nombre del archivo
.
Prueba esto:
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