Copiar y pegar rango de celda en libro a elegir en rango especifico
Tengo una hoja5 (nombre interno) con un rango EO7:EO917, este rango lo necesito copiar a otro libro en hoja1(nombre interno) en el rango D7:D917 pero el libro al que quiero copiar le cambio el nombre contanstemente.
¿
¿No se si hay alguna macro que me ayude que al copiar y querer pegar los datos este me pregunte en que libro lo deseo pegar?
1 Respuesta
Respuesta de Dante Amor
1
Te anexo la macro para que selecciones el libro y copie el rango de celdas en la hoja con nombre interno "Hoja1". La macro pega solamente valores, si quieres que pegue todo, cambia estas líneas:
Rango. Copy
h2.[D7].PasteSpecial Paste:=xlPasteValues
Por esta
rango.Copy h2.[D7]
Sub SeleccionaArchivo()
'Por.Dante Amor
Set l1 = ThisWorkbook
hoja = Hoja5.Name
Set h1 = l1.Sheets(hoja)
Set rango = h1.Range("EO7:EO917")
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Seleccione archivo de excel"
.Filters.Clear
.Filters.Add "xls*.*", "*.xls*"
.AllowMultiSelect = False
.InitialFileName = ThisWorkbook.Path & "\"
'.Show
If .Show Then
Application.ScreenUpdating = False
Set l2 = Workbooks.Open(.SelectedItems.Item(1))
nombrehoja = ""
For Each h In l2.Sheets
hx = h.CodeName
If hx = "Hoja1" Then
nombrehoja = h.Name
Exit For
End If
Next
If nombrehoja <> "" Then
Set h2 = l2.Sheets(nombrehoja)
'rango.Copy h2.[D7]
rango.Copy
h2.[D7].PasteSpecial Paste:=xlPasteValues
l2.Save
l2.Close
MsgBox "Copia realizada"
Else
MsgBox "No existe la hoja con nombre interno: Hoja1"
End If
End If
End With
End Sub
Saludos. Dante Amor
