Modificar macro para que también copie las fórmulas de las celdas
Quisiera que la macro que adjuntare también copie las fórmulas, ya no solo los valores de las celdas, he intentando agregando según lo que investigue en internet: "ws2.Range(celda.Address).Fórmula = celda.Fórmula", pero me da error 1004
[quote]
Sub TransferirDatos()
 Dim wb1 As Workbook
 Dim wb2 As Workbook
 Dim ws1 As Worksheet
 Dim ws2 As Worksheet
 Dim celda As Range
 Dim origen As String
 Dim destino As String
 Dim archivos() As String
 Dim archivo As Variant
 Dim hojas As Range
 Dim i As Long
 'Selecciona la carpeta origen
 origen = BrowseForFolder("Selecciona la carpeta origen.")
 'Sale de la macro si se cancela la selección de carpeta origen
 If origen = "" Then Exit Sub
 'Selecciona la carpeta destino
 destino = BrowseForFolder("Selecciona la carpeta destino.")
 'Sale de la macro si se cancela la selección de carpeta destino
 If destino = "" Then Exit Sub
 'Guarda las rutas completas en los rangos correspondientes
 ThisWorkbook.Sheets("transf").Range("I4").Value = origen
 ThisWorkbook.Sheets("transf").Range("I5").Value = destino
 'Verifica si la carpeta origen y destino son la misma
 If origen = destino Then
 MsgBox "La carpeta origen y destino son la misma. Seleccione una carpeta de destino diferente.", vbCritical
 Exit Sub
 End If
 Call AgregarDos
 'Obtiene la lista de archivos en la carpeta origen
 archivos = Split(CreateObject("WScript.Shell").Exec("CMD /C DIR """ & origen & "*.xls*"" /A:-D /B").StdOut.ReadAll, vbCrLf)
 'Abre el primer archivo en la carpeta origen
Set wb1 = Workbooks.Open(origen & archivos(0))
'Ejecuta la macro ListaHojas para escribir los nombres de las hojas en la hoja "transf"
ListaHojas wb1
 'Recorre la lista de archivos en la carpeta origen
 For Each archivo In archivos
 'Abre el archivo en la carpeta origen
 On Error GoTo fin
 Set wb1 = Workbooks.Open(origen & archivo)
 'Abre el archivo en la carpeta destino y desbloquea todas sus hojas
 Set wb2 = Workbooks.Open(destino & Replace(archivo, ".xls", "2.xls"), , , , "Dr4gOnnike01(_0)x-+dass@LOL@#=)$#LFMAO")
 For Each ws2 In wb2.Worksheets
 ws2.Unprotect "Dr4gOnnike01(_0)x-+dass@LOL@#=)$#LFMAO"
 Next ws2
 'Recorre la lista de hojas en la hoja "transf"
 For i = 2 To 39
 'Verifica si hay un "SI" en la columna A
 If ThisWorkbook.Sheets("transf").Range("A" & i).Value = "SI" Then
 'Obtiene el nombre de la hoja
 Dim hoja As String
 hoja = ThisWorkbook.Sheets("transf").Range("B" & i).Value
 'Verifica si la hoja existe en el libro 2
 On Error Resume Next
 Set ws2 = wb2.Sheets(hoja)
 On Error GoTo 0
 If ws2 Is Nothing Then
 MsgBox "La hoja " & hoja & " no existe en el libro de destino.", vbCritical
 Exit Sub
 End If
 'Transfiere los valores de las celdas
 Set ws1 = wb1.Sheets(hoja)
 For Each celda In ws1.UsedRange
 If Not IsEmpty(celda.Value) Then
 ws2.Range(celda.Address).Value = celda.Value
 End If
 Next celda
 End If
 Next i
 'Guarda y cierra los libros
 wb2.Close True
 wb1.Close False
Next archivo
'Finaliza la macro
MsgBox "Los datos han sido transferidos exitosamente.", vbInformation
fin: MsgBox "Los datos han sido transferidos exitosamente.", vbInformation
Call QuitarDos
End Sub
