Como copiar múltiple rangos de una hoja a otra

En tu petición original escribiste:

Ese proceso lo hago hoja por hoja, fila por fila

Prueba la siguiente macro. Copia todas las hojas como valores. También abre una ventana de diálogo para que guardes el nuevo archivo.

Sub Copiar_Hojas_Solo_Valores()
'Por Dante Amor
  'Copia todas las hojas como valores a un nuevo libro
  '
  Dim wb1 As Workbook, wb2 As Workbook
  Dim sh2 As Worksheet
  Dim arch As String
  '
  Set wb1 = ThisWorkbook
  wb1.Sheets.Copy
  Set wb2 = ActiveWorkbook
  For Each sh2 In wb2.Sheets
    sh2.Cells.Copy
    sh2.Range("A1").PasteSpecial xlPasteValues
  Next
  'Guardar nuevo archivo
  ChDir wb1.Path
  With Application.FileDialog(msoFileDialogSaveAs)
    .Title = "Guardar archivo como"
    .AllowMultiSelect = False
    .InitialFileName = "nuevo.xlsx"
    .FilterIndex = 1
    If .Show Then
        arch = .SelectedItems(1)
        wb2.SaveAs Filename:=arch
        wb2.Close
    End If
  End With
End Sub

Prueba y comenta.

Muchas gracias por tu respuesta; como mencione al principio, tengo mi archivo de excel original ejemplo "archivov1" con el cual voy introduciendo datos etc, de acuerdo a lo que necesite, si me surge alguna nueva idea, me hago otra version, "archivov2" con la base del anterior, pero en blanco yo le llamo (molde), a ese archivo lo mejoro estéticamente, cambio algunas fórmulas pero después de terminarlo, me toca pasar la información del archivov1, es decir copiar todos los valores, del archivov1 al archivov2, a excepción de las fórmulas, ( he intentado copiar fórmulas más pero me sale la ubicación del anterior archivo en la fórmulas del nuevo), básicamente es como recuperar un backup.

Llenar datos del archivo1 al 2 que esta en blanco.

Si no quieres toda la hoja y solamente el rango de H10 a AV145, prueba la siguiente macro:

Sub solamente_valores()
'Por Dante Amor
  Dim wb1 As Workbook, wb2 As Workbook
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim arch As String
  Dim a As Variant
  '
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  '
  Set wb1 = ThisWorkbook
  Set wb2 = Workbooks.Add(xlWBATWorksheet)
  wb2.Sheets(1).Name = "sh_temporal"
  '
  'copia los valores
  For Each sh1 In wb1.Sheets
    a = sh1.Range("H10:AV145").Value2
    wb2.Sheets.Add(, Sheets(wb2.Sheets.Count)).Name = sh1.Name
    wb2.Sheets(sh1.Name).Range("H10:AV145").Value = a
  Next
  '
  'Guarda el nuevo libro
  wb2.Sheets("sh_temporal").Delete
  With Application.FileDialog(msoFileDialogSaveAs)
    .Title = "Guardar archivo como"
    .AllowMultiSelect = False
    .InitialFileName = "nuevo.xlsx"
    .FilterIndex = 1
    If .Show Then
        arch = .SelectedItems(1)
        wb2.SaveAs Filename:=arch
        wb2.Close
    End If
  End With
End Sub

También tiene la ventana de diálogo para guardar el nuevo archivo.

Tu comentario:

Después de terminarlo, me toca pasar la información del archivov1, es decir copiar todos los valores, del archivov1 al archivov2,

Ambas macros que te puse, solamente copian valores.

Prueba y me comentas.

esa ultima version 

Sub solamente_valores()

esta muy bien!, como podria hacerlo para que toda esa informacion me lo copie a la nueva version del libro  que ya tengo creada y no a un archivo nuevo?

Si solamente quieres los valores y el libro destino está abierto, entonces es más simple.

Revisa el nombre del archivo y las hojas:

Sub pasar_valores()
  'archivo Destino                                                      Archivo Origen
  Workbooks("archivo2").Sheets("2TRIMESTRE").Range("H10:AV145").Value = ThisWorkbook.Sheets("1TRIMESTRE").Range("H10:AV145").Value
End Sub

definitivamente mas sencilla la solucion, el unico inconveniente es que al copiar asi, me quita las formulas del nuevo archivo.  lo de las formulas al menos cuando las copio me sale tambien la direccion del anterior archivo, es decir quedan como dependientes del anterior archivo.

entre mis ocurrencias tenia esto:

Copiar filas que tengan constantes

Fila : Desde la 10 Hasta la 145

De manera intercalada es decir:

Copiar fila 10,12, 13,15 16,18 hasta la 145

Columnas a omitir al pegar constantes (son celdas combinadas)

M,AC,AS Y AZ

Desde la columna H, hasta AV

¿El archivo destino tiene fórmulas?

Si, es totalmente usable con fórmulas,

Sub solamente_valores()

esta macro me venia bien ya que me copia todo, le puedo mandar mi archivo por correo?

Si tiene fórmulas y quieres pasar solamente los valores que en la columna H sean diferentes de espacio, entonces prueba esto:

Sub pasar_valores()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim i As Long, j As Long
  '
  Set sh1 = ThisWorkbook.Sheets("1TRIMESTRE")           'Origen
  Set sh2 = Workbooks("archivo2").Sheets("2TRIMESTRE")  'Destino
  For i = 10 To 145
    If sh1.Range("H" & i).Value <> "" Then
      For j = Columns("H").Column To Columns("AV").Column
        Select Case j
          Case Columns("M").Column, Columns("AC").Column, Columns("AS").Column
          Case Else
            sh2.Cells(i, j).Value = sh1.Cells(i, j).Value
        End Select
      Next
    End If
  Next
End Sub

Lo probé, pero lo copiar en el espacio que iban las fórmulas, le envíe el archivo, si se pudiera hacer con esta macro por favor, copia todo y eso me ahorraría muchísimo tiempo.

Sub solamente_valores()

le agradezco por su tiempo Dante Amor.

Prueba con este codigo

dim j as Byte
j = 2

'Le decimos desde que celda a que celda debe recorrer
For i = 2 To 101
'Damos la orden de activar la hoja a copiar
Sheets("Clientes"). Activate
'Queremos que busque la fechas mayor a 30
If Cells(i, "B").Value > 30 Then
'En este caso copio toda la fila
Range(Cells(i, "A"), Cells(i, "D")). Copy
'Activo la hoja a copiar los datos y en que celda comienzo
Sheets("Actualizar clientes"). Activate
Cells(j, "A").Select
'Ahora lo pego
ActiveSheet. Paste
'aumento la variable j para que vaya a la siguiente fila de la hoja Actualizar clientes
'cuando encuentre una nueva fila que cumple con la condición dada aumento 1
j = j + 1
End If
Next

Buen día, gracias por tu respuesta!, haciendo pruebas y modificando un poco la macro, para tomar los rangos precisos, me queda de esta forma:

Sub multiple()
Dim j As Byte
Dim i As Long
j = 2

'Le decimos desde que celda a que celda debe recorrer
For i = 10 To 145
'Damos la orden de activar la hoja a copiar
Sheets("1TRIMESTRE").Activate
'Queremos que busque la fechas mayor a 30
'If Cells(i, "h").Value >0 Then
'En este caso copio toda la fila
Range(Cells(i, "h"), Cells(i, "AU")).Copy
'Activo la hoja a copiar los datos y en que celda comienzo
Sheets("2TRIMESTRE").Activate
Cells(j, "h").Select
'Ahora lo pego
ActiveSheet.Paste
'aumento la variable j para que vaya a la siguiente fila de la hoja Actualizar clientes
'cuando encuentre una nueva fila que cumple con la condición dada aumento 1
j = j + 1
'End If
Next
End Sub

Lo que entiendo es que la macro va recorriendo por fila y preguntando si es mayor en este caso le puso a 0, lo va a pegar en otra hoja, para este fin omití la condición para que pueda copiar también letras, es decir números y letras, valores constantes, el problema esta que ahora también copia las fórmulas, es decir copia todo exactamente igual.

Ahora al tratar de pegar la información a otra hoja con el mismo formato, me dice que no puede copiar por que hay celdas combinadas, en este caso las celdas combiandas están ubicadas en la columnas: "M, AC, AS Y AZ", las cuales contienen fórmulas y pueden ser omitidas para que no afecten.

formato normal:

como lo pega en otra hoja:

Pero al pegarlo en la hoja con el mismo formato que la primera, salta el error de celdas combinadas.

En resumen:

Copiar filas que tengan constantes

Fila : Desde la 10 Hasta la 145

De manera intercalada es decir:

Copiar fila 10,12, 13,15 16,18 hasta la 145

Columnas a omitir al pegar constantes (son celdas combinadas)

M,AC,AS Y AZ

Desde la columna H, hasta AV

Pegar en los mismos rangos en otra hoja de otro libro a escoger

Vamos a ver si te entendí.

Lo que deberías hacer es primero decir que las celdas combinadas las deje como únicas.

Descomponer las celdas antes del bucle

j=2

Range (a1:c1). Unmergen

Luego las vuelvo a combinar

Then

Range(a1:c1). Mergen

Range(a1:s1:). Mergen

Range(a1:z1). Mergen

En caso de ser columno usaría

merge(a:c). Merge

Perdón es merge, se me colo la n en algunos casos, lo fui haciendo al momento.

Gracias por responder, para evitar copiar las celdas con fórmulas como sería ?

Tu quieres eliminar las celdas donde tienen fórmulas pon luego del paste:

Si es fila:

row("a:z").delete

si es columna:

column("a:a").delete

si es una fila especifica:

row("a1:a10").delete

Buenas tardes, en realidad es solo esto:

Copiar filas que tengan constantes

Fila : Desde la 10 Hasta la 145

De manera intercalada es decir:

Copiar fila 10,12, 13,15 16,18 hasta la 145

Columnas a omitir al pegar constantes (son celdas combinadas)

M,AC,AS Y AZ

Desde la columna H, hasta AV

Pegar en los mismos rangos en otra hoja de otro libro a escoger

No puedo eliminar nada, ni al copiar ni al pegar,  las filas tienen que conservar su  rango, lo copié de H16, lo tengo que pegar en el mismo rango pero en otra hoja, respetando que sea intercalado 

Copiar fila 10,12, 13,15 16,18 hasta la 145 

Y pegar en las mismas filas intercaladas en otra hoja 

Veamos si es esto a mi me a funcionado, elimando celdas combinadas

Y 2 descombinando las celdas y dejándolas en blanco. Cualquier cosa pásame la hoja y te la veo

Sub Copiar_y_Eliminar_Haga_clic_en()
Dim j As Byte
Dim i As Long

j = 2

'Le decimos desde que celda a que celda debe recorrer
For i = 5 To 16
'Damos la orden de activar la hoja a copiar
Sheets("hoja1").Activate
'Queremos que busque la fechas mayor a 30
'If Cells(i, "h").Value >0 Then
'En este caso copio toda la fila
Range(Cells(i, "C"), Cells(i, "J")).Copy
'For Each celda In Range
'Activo la hoja a copiar los datos y en que celda comienzo
Sheets("hoja2").Activate
Cells(j, "h").Select
'Ahora lo pego
ActiveSheet.Paste

'aumento la variable j para que vaya a la siguiente fila de la hoja Actualizar clientes
'cuando encuentre una nueva fila que cumple con la condición dada aumento 1
j = j + 1
'End If
Next
Range("m:m").EntireColumn.Delete
Range("c:c").EntireColumn.Delete
Range("f:f").EntireColumn.Delete
Range("h:h").EntireColumn.Delete
End Sub
Sub Copiar_Formato_Haga_clic_en()
Dim j As Byte
Dim i As Long

j = 2

'Le decimos desde que celda a que celda debe recorrer
For i = 5 To 16
'Damos la orden de activar la hoja a copiar
Sheets("hoja1").Activate
'Queremos que busque la fechas mayor a 30
'If Cells(i, "h").Value >0 Then
'En este caso copio toda la fila
Range(Cells(i, "C"), Cells(i, "J")).Copy
'For Each celda In Range
'Activo la hoja a copiar los datos y en que celda comienzo
Sheets("hoja2").Activate
Cells(j, "h").Select
'Ahora lo pego
ActiveSheet.Paste

'aumento la variable j para que vaya a la siguiente fila de la hoja Actualizar clientes
'cuando encuentre una nueva fila que cumple con la condición dada aumento 1
j = j + 1
'End If
Next
Range("c:c"). EntireColumn. UnMerge
Range("m:m"). EntireColumn. ClearContents
Range("c:c"). EntireColumn. ClearContents
Range("f:f"). EntireColumn. ClearContents
Range("h:h"). EntireColumn. ClearContents
End Sub

Perdón recién leo bien tu pregunto.

Prueba esto crea un libro que se llame librotemporal. Xlxs con las reformas que hayas hecho, luego de pegar en el se abrirá y lo guardas con el nombre que quieres.

Dim Destino As Workbook, _
    Origen As Excel.Worksheet, _
    WsDestino As Excel.Worksheet, _
    Origen1 As Excel.Range, _
    Destino1 As Excel. Range
'Indicar el libro de Excel destino
Set Destino = Workbooks.Open(ActiveWorkbook.Path & "\LibroTemporal.xlsx")
'ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Ruta & "\" & nombre & ".pdf", Quality:= _
'xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
'Activar este libro
ThisWorkbook.Activate
'Indicar las hojas de origen y destino
Set Origen = Worksheets("Origen")
Set wsDestino = Destino.Worksheets("Destino")
'Indicar la celda de origen y destino
Const celdaOrigen = "h10:av145"
Const celdaDestino = "h10:av145"
'Inicializar los rangos de origen y destino
Set Origen1 = Origen.Range(celdaOrigen)
Set Destino1 = wsDestino.Range(celdaDestino)
'Seleccionar rango de celdas origen
Origen1.Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
'Pegar datos en celda destino
Destino1.PasteSpecial xlPasteValues
Application.CutCopyMode = False
'Guardar el libro de Excel destino
Destino. Save

muchas gracias por tu respuesta, en este caso sale un error