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

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)

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

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
- Compartir respuesta
