Tengo una macro que me abre un Excel y me rellena una serie de datos. Hasta ahí todo correcto.
Pero me gustaría darle un poco mas de utilidad y que me abriera el archivo con el nombre que finalmente deseo guardarlo y lo guardara en la carpeta correspondiente
Sub MetodoAbrirLibro()
Dim rngCopy As Range, rngCopyOT2 As Range, rngOT1 As Range, rngOT2 As Range, cel As Range, cel2 As Range, adres$
Dim wbOr As Workbook, wbDes As Workbook
Dim nombre As String, Ruta As String
Application.ScreenUpdating = False
Set wbOr = ThisWorkbook
Set wbDes = Workbooks.Open("C:\Users\jctorres\Desktop\Partes presenciales\C2020-0136_Carga_Horas (1)2.xls")
With wbOr.Sheets("EPYC1")
.Range("A8:F108").Copy
wbDes.Sheets("Personal").Range("A8:F108").PasteSpecial xlPasteValues
.Range("F2").Copy
wbDes.Sheets("Personal").Range("G3").PasteSpecial xlPasteValues
.Range("I2").Copy
wbDes.Sheets("Personal").Range("H3").PasteSpecial xlPasteValues
Set rngOT1 = .Range("A:U")
Set rngCopy = Intersect(rngOT1, Union(.Range("H2"), .Range("H3"), .Range("l2"), .Range("G8:H108"), .Range("J8:K108"), .Range("M8:M108")))
For Each cel In rngCopy
adres = cel.Address
wbDes.Sheets("OT1").Range(adres).FormulaR1C1 = cel.Value
Next cel
End With
Esta es la primera parte del código , esta en el modulo 4.
Buenos días
Tengo una macro que me abre un Excel y me rellena una serie de datos. Hasta ahí todo correcto.
Pero me gustaría darle un poco mas de utilidad y que me abriera el archivo con el nombre que finalmente deseo guardarlo y lo guardara en la carpeta correspondiente
Sub MetodoAbrirLibro() Dim rngCopy As Range, rngCopyOT2 As Range, rngOT1 As Range, rngOT2 As Range, cel As Range, cel2 As Range, adres$ Dim wbOr As Workbook, wbDes As Workbook Dim nombre As String, Ruta As String Application.ScreenUpdating = False Set wbOr = ThisWorkbook Set wbDes = Workbooks.Open("C:\Users\jctorres\Desktop\Partes presenciales\C2020-0136_Carga_Horas (1)2.xls") With wbOr.Sheets("EPYC1") .Range("A8:F108").Copy wbDes.Sheets("Personal").Range("A8:F108").PasteSpecial xlPasteValues .Range("F2").Copy wbDes.Sheets("Personal").Range("G3").PasteSpecial xlPasteValues .Range("I2").Copy wbDes.Sheets("Personal").Range("H3").PasteSpecial xlPasteValues Set rngOT1 = .Range("A:U") Set rngCopy = Intersect(rngOT1, Union(.Range("H2"), .Range("H3"), .Range("l2"), .Range("G8:H108"), .Range("J8:K108"), .Range("M8:M108"))) For Each cel In rngCopy adres = cel.Address wbDes.Sheets("OT1").Range(adres).FormulaR1C1 = cel.Value Next cel End With
Esta es la primera parte del código , esta en el modulo 4.
Gracias de antemano
C2020-0136_Carga_Horas (1)2.xls epycSO REV 1.xlsm