COMBINAR CELDAS SEGÚN EL VALOR ASIGNADO

ofol · el 8 de septiembre

BUENAS TARDES AMIGOS.

NECESITO QUE ME AYUDEN CON UNA PROGRAMACIÓN

QUISIERA COMBINAR DIFERENTES CELDAS , SEGÚN EL VALOR ASIGNADOS.

MUCHAS GRACIAS, ESPERO QUE ME PUEDAN AYUDAR

COMBINAR.xls

DiegoLG · el 8 de septiembre

Estimad@ @ofol

Lo que no se si la columna K:L debe de cumplir exactamente las dos columnas.

valida con este código:

Sub combinar()

For i = 8 To Hoja2.Cells(Rows.Count, "C").End(xlUp).Row
If Hoja2.Cells(i, 3) = Hoja2.Range("K13") Or Hoja2.Cells(i, 3) = Hoja2.Range("L13") Then Hoja2.Range(Cells(i, 4), Cells(i, 7)).Merge
If Hoja2.Cells(i, 3) = Hoja2.Range("K14") Or Hoja2.Cells(i, 3) = Hoja2.Range("L14") Then Hoja2.Range(Cells(i, 4), Cells(i, 7)).Merge
If Hoja2.Cells(i, 3) = Hoja2.Range("K15") Or Hoja2.Cells(i, 3) = Hoja2.Range("L15") Then Hoja2.Range(Cells(i, 4), Cells(i, 7)).Merge
Next

End Sub

Lo que hace es: si la columna C cumple con una de las condiciones que se encuentran en la columna K:L entonces que combine de la columna D:G.

Espero haberte ayudado,

Saludos,

Diego.

ofol · el 9 de septiembre

estimado @DiegoLG agradezco tu respuesta.

lo que necesito es que el macro me combine la columna D, E, F, G. en sentido vertical.

es decir, que con valores de las columnas K13 y L13 me combine las celdas (D8:D11 , E8:E11 , F8:F11 , G8:G11) y así sucesivamente .

te agradecería se me pudieras ayudar un código para poder realizar esa operacion

muchas gracias.

Saludos cordiales

Antoni · el 9 de septiembre

Sub Combinar_Celdas()
   Application.ScreenUpdating = False
   Aplicar CDbl([K13]), CDbl([L13])
   Aplicar CDbl([K14]), CDbl([L14])
   Aplicar CDbl([K15]), CDbl([L15])
   Application.ScreenUpdating = True
End Sub

Sub Descombinar_Celdas()
   Application.ScreenUpdating = False
   Aplicar CDbl([K13]), CDbl([L13]), True
   Aplicar CDbl([K14]), CDbl([L14]), True
   Aplicar CDbl([K15]), CDbl([L15]), True
   Application.ScreenUpdating = True
End Sub

Private Sub Aplicar(K As Double, L As Double, Optional Descombinar As Boolean = False)
For x = 8 To Range("C" & Rows.Count).End(xlUp).Row
   If Range("C" & x) = K Then i = x
   If Range("C" & x) = L Then f = x
   If i > 0 And f > 0 Then
      If Descombinar = False Then
         Range("D" & i & ":D" & f).Merge
         Range("E" & i & ":E" & f).Merge
         Range("F" & i & ":F" & f).Merge
         Range("G" & i & ":G" & f).Merge
      Else
         Range("D" & i & ":D" & f).UnMerge
         Range("E" & i & ":E" & f).UnMerge
         Range("F" & i & ":F" & f).UnMerge
         Range("G" & i & ":G" & f).UnMerge
      End If
      Exit Sub
   End If
Next
End Sub