Macro conservar ancho y alto de las celdas al copiar rango de una hoja a otra

[coyuyos]

Me gustaría que me ayuden a desarrollar una macro que a la hora de

copiar y pegar conserve el ancho y alto de las celdas.

Tengo en mi poder una macro que hace lo que quiero pero funciona así:

-Me pide que seleccione el rango(mouse),luego pulso un botón

(macro),se abre un inputbox donde me pide seleccionar la celda donde

quiero que se pegue el rango(mouse) y luego se pega.Ésta macro

funciona bien pero quiero que lo haga de forma directa (SIN que

seleccione el rango manualmente y sin que se abra el formulario).
Tendría que poner en la misma macro los rangos de copiado y de pegado.

Adjunto Libro.

500.rar

[coyuyos]

Alguien que me ayude con esta macro

Sub test()
Dim rng As Range, nrng As Range, i As Long, msg As String
On Error GoTo Salida
Set rng = Selection
Set nrng = Application.InputBox( _
prompt:="Selecciona el rango de destibo:", _
Title:="Copiar Tabla", _
Type:=8).Resize(rng.Rows.Count, rng.Columns.Count)
rng.Copy nrng
Application.ScreenUpdating = False
For i = 1 To rng.Columns.Count
nrng.Columns(i).ColumnWidth = rng.Columns(i).ColumnWidth
Next i
For i = 1 To rng.Rows.Count
nrng.Rows(i).RowHeight = rng.Rows(i).RowHeight
Next i
Application.ScreenUpdating = True
Exit Sub
Salida:
msg = msg & "No se ha podido efectuar la operacion." & Chr(10)
msg = msg & "Comprueba que:" & Chr(10)
msg = msg & "1) la tabla a copiar este seleccionada." & Chr(10)
msg = msg & "2) el rango de destino sea un rango valido." & Chr(10)
MsgBox msg
Application.ScreenUpdating = True
End Sub