Macro no guarda el alto de las celdas

Te falta decirle que pegue el alto de filas, ¿no?

Selection.PasteSpecial Paste:=xlPasteColumnWidths 
    Selection.PasteSpecial Paste:=xlPasteRowHeights 

me da error me puedes copiar la formula entera para ver donde pongo lo de pegar el alto de columna?

Gracias

Tienes razón que da un error, no lo había probado.

Me esta faltando más información porque recién lo probé y la altura se ajusta automáticamente (si es necesario aumentarla, no si necesita disminuirla).

Vos querés copiar el rango de la hoja CHOCO, y pegarlo en la hoja RESULTADOS. Y que la hoja resultados el formato (alto y ancho) te quede igual que en Choco para que quede todo en una hoja A4 al imprimir, ¿correcto?

Si hasta acá voy bien, me esta faltando saber el alto de las filtas en CHOCO porque 150 filas es mucho para una sola hoja.

Con que quede igual que la hoja choco es suficiente he puesto mas rango por si un dia necesito dos o mas hojas, ya que la hoja choco ya esta preparada para imprimir A4

Solo tiene que tener el mismo alto y ancho que choco, independientemente del alto o ancho

Acá te agrego un par de líneas en el código para que ponga todas las filas de la altura de la fila 2 de choco:

Sub copiarypegar()
'ajustada x Elsamatilde
Sheets("CHOCO").Select
'Toma altura de fila 2 de CHOCO
altura = Range("S2").Rows.Height
Range("S1:AL150").Copy         'AJUSTAR RANGO
Sheets("RESULTADO").Select
Range("b1").Select
ActiveSheet.Paste
'pega ancho de col
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'Pone altura igual que fila 2 de Choco
Selection.RowHeight = altura
'descombina celdas
Selection.UnMerge
Range("B1").Select
End Sub

me da error

Selection.RowHeight = altura

Ya lo veo, no quiero que me de la altura que tiene la celda A2 Si no que pegue todos las cedas a la misma altura de origen, de la A2 a la A100 tienen diferente altura

¿Cada una tiene una altura diferente?

Siempre pone el tipo de error que te aparece así me evito tener que adivinar lo que pasa del otro lado.

asi es, cada fila tiene diferente altura

Lo del error ya he visto que era un error mio

Se puede hacer algo para que copie las columnas y filas con la misma anchura que la de origen?

Gracias

 anchura y altura que la de origen?

Gracias

Si, se puede... me resulta raro para un archivo de excel, pero bueno, no es dificil de hacer. En unos minutos te lo paso y me cuentas.

Acá te lo paso: Tomo la altura de cada fila de CHOCO (hasta la 150) y las reproduce en RESULTADOS

Sub copiarypegar()
'ajustada x Elsamatilde
Dim altura(1 To 150)
Sheets("CHOCO").Select
'Toma altura de fila 2 de CHOCO
For i = 1 To 150
    altura(i) = Cells(i, 1).Rows.Height
Next i
Range("S1:AL150").Copy         'AJUSTAR RANGO
Sheets("RESULTADO").Select
Range("b1").Select
ActiveSheet.Paste
'pega ancho de col
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'descombina celdas
Selection.UnMerge
'Pone altura igual que fila 2 de Choco
For i = 1 To 150
    Cells(i, 1).RowHeight = altura(i)
Next i
'Selection.RowHeight = altura
Range("B1").Select
End Sub

perfecto, GRACIAS

Para mejorarla, necesitaría la misma formula pero para copiar hojas de

Libro( necesidades.xlxs ( choco

DESTINO

Libro STOCK.XLXS( RESULTADO

Te refieres a que en lugar de estar en el mismo libro, ¿las hojas están en libros diferentes? Están los dos abiertos, ¿correcto?

Asumo que si esta abiertos los dos libros, va el código.

Igualmente tené presente que para que las macros estén habilitadas, el libro necesidades debe ser un xlsm (Macro Enabled).

Sub copiarypegar()
'ajustada x Elsamatilde
'ajustado alto filas x Javier Casabal
Dim altura(1 To 150)
'Este libro es Necesidades.xlsm
ThisWorkbook.Activate
Sheets("CHOCO").Select
'Toma altura de fila 2 de CHOCO
For i = 1 To 150
    altura(i) = Cells(i, 1).Rows.Height
Next i
Range("S1:AL150").Copy
'Voy al otro libro
Windows("stocks.xlsx").Activate
Sheets("RESULTADO").Select
Range("b1").Select
ActiveSheet.Paste
'pega ancho de col
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'descombina celdas
Selection.UnMerge
'Repite altura de las 150 filas de CHOCO
For i = 1 To 150
    Cells(i, 1).RowHeight = altura(i)
Next i
Range("B1").Select
End Sub

¡Gracias! 

mil gracias

Intento poner la macro en el libro de destino, porque el libro de origen es compartido Me puedes ayudar no me sale

Una cosa mas, se podría decir que copie dos hojas del libro de origen y pegarlas en dos hojas diferentes en destino?

A ver, vayamos por partes.

"Necesidades.xlsx" es Origen y es Compartido.

"Stocks.xlsm" es Destino y ahí ponemos la macro (por eso cambie la extensión).

Ahora pone este código en Stocks.xlsm y decime si anda bien esa parte.

Por lo de las copiar hojas, decime algunos detalles más. Si, se puede. Lo más importante es: ¿Las hojas del libro Origen tienen fórmulas? ¿Quieres solo copiar los valores?

Sub copiarypegar()
'ajustada x Elsamatilde
'ajustado alto filas x Javier Casabal
Dim altura(1 To 150)
'Voy al libro Necesidades.xlsm
Windows("Necesidades.xlsx").Activate
Sheets("CHOCO").Select
'Toma altura de fila 2 de CHOCO
For i = 1 To 150
    altura(i) = Cells(i, 1).Rows.Height
Next i
Range("S1:AL150").Copy
'Voy al otro Destino
'Windows("stocks.xlsm").Activate
'Ahora Este libro es Stocks.xlsm
ThisWorkbook.Activate
Sheets("RESULTADO").Select
Range("b1").Select
ActiveSheet.Paste
'pega ancho de col
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'descombina celdas
Selection.UnMerge
'Repite altura de las 150 filas de CHOCO
For i = 1 To 150
    Cells(i, 1).RowHeight = altura(i)
Next i
Range("B1").Select
End Sub

Tiene de todo ya que luego se imprime

Una vez copiada aplico otra macro donde me da los totales que necesito y se imprime

Tendría que copiar todos los datos: altos, anchos, formulas, combinaciones de celdas y imágenes

La he probado y funciona bien pega todo. No se si sera que tiene algun problema pero durante la ejecucion de la macro se queda trabajando 8segundos de reloj como si se quedara trabado

En el apartado descombinar celdas necesitaria que solo descombinara el rango d6:u150

Es posible?

Sub copiarhojas()
'
Windows("Necesidades.xlsx").Activate
Sheets("A").Copy After:=Workbooks("stocks.xlsm").Sheets(Workbooks("stocks.xlsm").Sheets.Count)
Windows("Necesidades.xlsx").Activate
Sheets("B").Copy After:=Workbooks("stocks.xlsm").Sheets(Workbooks("stocks.xlsm").Sheets.Count)
End Sub

No creo que sea un problema de la macro. El tema es que le estas pidiendo que modifique de a una la altura de las celdas.

Pruébala así:

Sub copiarypegar()
'ajustada x Elsamatilde
'ajustado alto filas x Javier Casabal
Application.Calculation = xlCalculationManual
Dim altura(1 To 150)
'Voy al libro Necesidades.xlsm
Windows("Necesidades.xlsx").Activate
Sheets("CHOCO").Select
'Toma altura de fila 2 de CHOCO
For i = 1 To 150
    altura(i) = Cells(i, 1).Rows.Height
Next i
Range("S1:AL150").Copy
'Voy al otro Destino
'Windows("stocks.xlsm").Activate
'Ahora Este libro es Stocks.xlsm
ThisWorkbook.Activate
Sheets("RESULTADO").Select
Range("b1").Select
ActiveSheet.Paste
'pega ancho de col
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'descombina celdas
Selection.UnMerge
'Repite altura de las 150 filas de CHOCO
For i = 1 To 150
    Cells(i, 1).RowHeight = altura(i)
Next i
Range("B1").Select
Salir:
Application.Calculation = xlCalculationAutomatic
End Sub

Funciona bien pero el problema de trabarse sigue igual

Es porque la hoja "choco" tiene imágenes de logotipos

La he probado en otra hoja que no tiene logotipos y va perfecta

Fíjate así a ver si anda mejor.

Sub copiarypegar()
'ajustada x Elsamatilde
'ajustado alto filas x Javier Casabal
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim altura(1 To 150)
'Voy al libro Necesidades.xlsm
Windows("Necesidades.xlsx").Activate
Sheets("CHOCO").Select
'Toma altura de fila 2 de CHOCO
For i = 1 To 150
    altura(i) = Cells(i, 1).Rows.Height
Next i
Range("S1:AL150").Copy
'Voy al otro Destino
'Windows("stocks.xlsm").Activate
'Ahora Este libro es Stocks.xlsm
ThisWorkbook.Activate
Sheets("RESULTADO").Select
Range("b1").Select
ActiveSheet.Paste
'pega ancho de col
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'descombina celdas
Selection.UnMerge
'Repite altura de las 150 filas de CHOCO
For i = 1 To 150
    Cells(i, 1).RowHeight = altura(i)
Next i
Range("B1").Select
Salir:
Application.Calculation = xlCalculationAutomatic
End Sub

Gracias

AHORA perfecto

Sheets("RESULTADO").Select
Range("D5:Z150").UnMerge
Application.CutCopyMode = False

Le pongo este código para que no descombine toda la hoja pero descombina toda la hoja igualmente

Que hago mal?

Ya lo veo había una fila combinada desde E5:E9

Lo dicho perfecto como esta