Al eliminar línea en Página, se descombinan las celdas en Página 2

Para DanteAmor

De nuevo Dante. No recordaba la pregunta

En ese mismo archivo, cuando elimino una o más líneas en PAGINA1, en PAGINA2 desaparece la combinación de celdas entre DE y I como puedes observar en la imagen. Si elimino en la página 2 nada pasa, todo corre bien

    For i = 11 To 46
        Range("D" & i & ":I" & i).Merge
        Range("D" & i & ":I" & i).HorizontalAlignment = xlCenter
        Range("O" & i & ":T" & i).Merge
        Range("O" & i & ":T" & i).VerticalAlignment = xlCenter
    Next

Para otra pregunta es que al eliminar línea(s) en PAGINA1, si hay datos en pagina2, al trasladar hacia la pagina1, en la celda B de la página 1, me inserta(traslada y me queda la B sin el formato personalizado (000)

Estos 2 puntos, no son de ahora, ya hace tiempo, creo que desde un principio, aunque tengo la columna B y M con formato personalizado 000

1 Respuesta

Respuesta
1

Envíame la última versión de tu archivo

Esa misma que tienes, la ultima que te envíe, pero te enviaré nuevamente.

Lo que hago es usar la plantilla, la lleno y mando crear un archivo XLSX y otro PDF y la plantilla sigue como si nada.

Pero mientras lleno, si llene la Página 1 y sigo en la Página 2, pero por alguna circunstancia tengo que eliminar alguna línea en la Página 1, sucede que en el traslado de línea datos de la página 2 hacia la página 1, el combinado de celdas en la página 2 desaparece.

Voy enviarte un otro

Te anexo el código

Const GWL_STYLE = -16
Const WS_CAPTION = &HC00000
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'Cerrar formulario
Private Sub cbtCera_Click()
    Application.ScreenUpdating = False
    Set h2 = Sheets("filtro")
    h2.Unprotect Password:="By Jot@"
        h2.Cells.Clear 'Contents
        Unload Me
    h2.Protect Password:="By Jot@"
    Application.ScreenUpdating = True
End Sub
'Elimina y vuelve a filtrar para actualisar tabla.
Private Sub cbtElimi_Click()
'Por.Dante Amor http://www.todoexpertos.com/preguntas/6tq7iumqenw3rrpx/eliminar-los-registros-seleccionados-en-el-listbox
    'Eliminar el registro
    ActiveSheet.Unprotect Password:="By Jot@"
    If Lista2.ListIndex = -1 Then
        MsgBox "No hay registros"
        Exit Sub
    End If
    seleccionado = False
    For i = 0 To Lista2.ListCount - 1
        If Lista2.Selected(i) Then
            seleccionado = True
            Exit For
        End If
    Next
    If seleccionado = False Then
        MsgBox "Selecciona un registro"
        Exit Sub
    End If
    Pregunta = MsgBox("Está seguro para eliminar el registro?", vbYesNo + vbQuestion, "Eliminación")
    If Pregunta = vbNo Then Exit Sub
'Selecciona la pagina
    If OptionButton1 Then
        c1 = "B": c2 = "K": c3 = "C": c4 = "D"
    ElseIf OptionButton2 Then
        c1 = "M": c2 = "V": c3 = "N": c4 = "O"
    End If
'Elimina lo seleccionado
    Application.ScreenUpdating = False
    For i = Lista2.ListCount - 1 To 0 Step -1
        If Lista2.Selected(i) Then
            fila = Lista2.List(i, 10)
            If fila < 46 Then
                Range(c1 & fila + 1 & ":" & c2 & 46).Copy Range(c1 & fila)
            End If
            Range(c1 & 46 & ":" & c2 & 46).ClearContents
            'Mover registro de página 2
            If Range("M11") <> "" Then
                Range("B46") = Range("M11")
                Range("C46") = Range("N11")
                Range("D46") = Range("O11")
                Range("J46") = Range("U11")
                Range("K46") = Range("V11")
                Range("M12:V46").Copy Range("M11")
            End If
        End If
    Next
    Call FiltrarLista2(c1, c2, c3, c4, True)
'Combina las celdas D:I y O:T y da formato centrado
    Application.ScreenUpdating = False
    For i = 11 To 46
        Range("D" & i & ":I" & i).Merge
        Range("D" & i & ":I" & i).HorizontalAlignment = xlCenter
        Range("O" & i & ":T" & i).Merge
        Range("O" & i & ":T" & i).VerticalAlignment = xlCenter
    Next
    Range("B11:B46").NumberFormat = "000"
    Range("M11:M46").NumberFormat = "000"
    ActiveSheet.Protect Password:="By Jot@"
    Application.ScreenUpdating = True
End Sub
'
'Mostrar resultado filtrados, por el boton Filtro en ListBox
Private Sub cbtFiltro_Click() 'LISTO
'Por.Dante Amor  http://www.todoexpertos.com/preguntas/6tq6n98o8eefyo4j/arreglar-la-macro-para-filtrar-con-el-textbox?nid=gcqp5uuggnw63hkphks99g6ma4qp9tm5gso6jgulabr3&utm_source=todoexpertos&utm_medium=EmailNotification&utm_campaign=AskerQuestion_ExpertMessageAdded
    If OptionButton1 Then
        Call FiltrarLista2("B", "K", "C", "D") 'inicio y fin de rango y filtrar por columna C y D
    ElseIf OptionButton2 Then
        Call FiltrarLista2("M", "V", "N", "O") 'inicio y fin de rango y filtrar por columna N y O
    Else
    'Si no existe ningun Option seleccionado, manda mensaje
        MsgBox "selecciona una página", vbCritical, "Selección"
    End If
End Sub
'Activar la (linea) del rango (OptionButton) elegido.ESTA EN VEREMOS
Private Sub Lista2_Click()
Range("a2").Activate
Cuenta = Lista2.ListCount
Set rango = Range("A1").CurrentRegion
For i = 0 To Cuenta - 1
    If Lista2.Selected(i) Then
        Valor = Lista2.List(i)
        rango.Find(what:=Valor, LookAt:=xlWhole, After:=ActiveCell).Activate
    End If
Next i
End Sub
'Filtrado con los OptionButton LISTO
'Nuevo por Dante
Private Sub OptionButton1_Click()
    Call FiltrarLista2("B", "K", "C", "D")  'inicio y fin de rango y filtrar por columna C y D
End Sub
Private Sub OptionButton2_Click()
    Call FiltrarLista2("M", "V", "N", "O") 'inicio y fin de rango y filtrar por columna N y O
End Sub
Sub FiltrarLista2(col1, col2, col3, col4, Optional verifica As Boolean)
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("Lista Repuestos")
    Set h2 = Sheets("filtro")
    h2.Unprotect Password:="By Jot@"
    h2.Cells.Clear 'Contents
    Lista2.RowSource = ""
    fila = 46
    h1.Range("B10:K10").Copy h2.Range("A1")
    j = 2
    For i = 11 To 46
        If Cells(i, col1) <> "" And _
           UCase(h1.Cells(i, col3) & h1.Cells(i, col4)) Like "*" & UCase(txtFiltro) & "*" Then
            h1.Range(col1 & i & ":" & col2 & i).Copy h2.Cells(j, "A")
            h2.Cells(j, "K") = i
            j = j + 1
        End If
    Next
    u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
    If u2 > 1 Then
        Lista2.RowSource = h2.Name & "!A2:K" & u2
    Else
        If verifica = False Then
            MsgBox "No se encuentra.", vbExclamation, "Inexistente"
        End If
    End If
    h2.Protect Password:="By Jot@"
    Application.ScreenUpdating = True
End Sub
'Dar formato al ListBox y traer datos de la tabla
Private Sub UserForm_Initialize()
frmEliminar.Height = 220
frmEliminar.Width = 405
'Ocultar barra de titulo
    Dim lngWindow As Long, lFrmHdl As Long
    lFrmHdl = FindWindowA(vbNullString, Me.Caption)
    lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE)
    lngWindow = lngWindow And (Not WS_CAPTION)
    Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow)
    Call DrawMenuBar(lFrmHdl)
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

Hola Dante

Volví por undécima ves copiar TODA las macros que dejaste en esta pregunta.

Eliminando en la página 1, traslada de la pagina2 hacia la página 1 bien, sea eliminando solo una línea o 3 y el formato en la B queda y también la combinación de celdas en la 2; BIEN.

Eliminando en la Página 2 NO tenia porque tocar en la Página 1 y si lo hace.

Si elimino en Pagina2 una sola línea, elimina la ultima de la página 1 para trasladar la 1ª línea de la página 2 hacia la página 1 si elimino 3 de la 2, elimina las 3 ultimas de la 1 para trasladar de la 2 hacia la 1.

Elimine las 3 primeras ROLINERA de la página 2 y me paso hacia pagina1 los 3 primeros renglones y me dejo una rolinera (que no elimino)

Puse la macro para que veas los cambios, pero tienes que probar en el archivo que te envié.

Hola Dante

Si probé pero en especial cuando elimino en página 2 me lo hacwe también en página 1 la o las ultimas líneas dependiendo si selecciono una o más líneas para eliminar. Eliminándolas me lo hace también en las ultimas de la Pagina1 y hace el traslado de la 2 hacia la 1

Agregué esta línea

 Range("M46:V46"). ClearContents

Prueba la versión D que te envié

Dante Crearé nueva pregunta para lo del formato

"Dar formato a celdas mde determinada columna con macro"

Esa línea

Range("M46:V46"). ClearContents

no la encuentro en ninguna parte del código en general del Celdas N_T combinadas_formato person en C ni del B

Hablas en: Prueba la versión DE que te envié . La DE no la recibí pero esta ultima es la C que probé y ya te explique en un mail

Saludos y mil gracias

Lo que si le falta es el mensaje SOLO de cuando TRASLADA DE LA 2 HACIA LA 1 si no traslada no haría falta (CREO)

No es necesario el mensaje, todo quedó automático

Solo esta

La macro Sub AcomodLinP2aP1() puedo eliminar ese modulo TrasladoLinea?

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas