JSDJSD

Seleccionas el archivo que quieras pones un nuevo nombre y cuando pulsas guardar te hace los cambios

Observa el gif, hace lo que comentas

Algo como esto ?

Tal cual esta el código veras que ingresas un número de factura alfanumérico te dará error, intenta adaptarlo tu mismo y si no lo consigues consulta y lo modificamos

El archivo Registor 2 condiciones.xlsm

Te dejo una posible solución

Si pones el número de factura automático te evitas cualquier problema de repetición y la fecha también se puede poner por defecto y no tienes que preocuparte de ponerla a no ser que la fecha de facturación sea diferente al día en el cual factures.

Abre un nuevo tema y un ejemplo del resultado esperado

Este sería el código de tu botón

Se hace mediante Custom UI Editor y programación XML

La forma del botón color y texto de la figura seleccionada según tu gusto

Otra opción la que te comenta el Maestro Antoni

Aquí tienes el archivo, prueba y comenta Organización Formaciones Centro (1 opcion).xlsm

De todos modos te dejo una opción que creo será mucho más cómoda para ti. Observa que en la barra ribbon tienes una nueva pestaña llamada Consolidar hojas en la que tienes un botón llamador Actualizar, simplemente púlsalo y se ejecuta la macro independientemente en la hoja que te encuentres. Si la hoja existe la actualiza y si no existe te la crea.

Esto ya lo hace la macro, no hay que modificarle nada

Sin ningún tipo de problema

Tal cual tienes el archivo subido tiene que funcionar si o si, simplemente darle un click sobre el botón

Sin tu archivo no es posible ayudarte

Sub ConsolidarSeguimientos(): Application.ScreenUpdating = False primeraCopia = True On Error Resume Next Set destino = Sheets("Seguimiento_Anual") If destino Is Nothing Then Set destino = Sheets.Add destino.Name = "Seguimiento_Anual" Else destino.Cells.Clear End If On Error GoTo 0 For Each ws In ThisWorkbook.Worksheets If ws.Name Like "Seguimiento_*" And ws.Name <> "Seguimiento_Anual" Then If Application.WorksheetFunction.CountA(destino.Cells) = 0 Then ultimaFila = 1 Else ultimaFila = destino.Cells(destino.Rows.Count, "A").End(xlUp).Row + 1 End If If primeraCopia Then ws.UsedRange.Copy Destination:=destino.Cells(ultimaFila, 1) primeraCopia = False Else ws.UsedRange.Offset(1, 0).Resize(ws.UsedRange.Rows.Count - 1).Copy _ Destination:=destino.Cells(ultimaFila, 1) End If End If Next ws ultimaFila = destino.Cells(destino.Rows.Count, "A").End(xlUp).Row Dim i As Long For i = ultimaFila To 2 Step -1 If IsEmpty(destino.Cells(i, 3)) Then destino.Rows(i).Delete End If Next i With destino.Sort .SortFields.Clear .SortFields.Add Key:=destino.Range("A2:A" & ultimaFila), Order:=xlAscending .SortFields.Add Key:=destino.Range("B2:B" & ultimaFila), Order:=xlAscending .SetRange destino.Range("A1").CurrentRegion .Header = xlYes .Apply End With destino.UsedRange.Columns.AutoFit MsgBox "Consolidación completada.", vbInformation End Sub Organización Formaciones Centro (1).xlsm

A ver si es esto lo que necesitas

Me alegro

Cambia tu macro5 por esta modificada y comenta Sub Paso5() Dim ws As Worksheet Dim tbl As ListObject Dim celda As Range Dim colIndex As Integer Dim lastRow As Long Dim currentRow As Long ' Seleccionar la hoja llamada "Consulta1" Set ws = ThisWorkbook.Sheets("Consulta1") ' Establecer la tabla "Consulta1" Set tbl = ws.ListObjects("Consulta1") ' Recorrer todas las celdas en el rango de datos de la tabla For Each celda In tbl.DataBodyRange ' Verificar si la celda contiene el texto "Cantidad Pedida" If celda.Value = "Cantidad Vendida" Then colIndex = celda.Column currentRow = celda.Row + 1 ' Mover el contenido de las celdas debajo de "Cantidad Pedida" a la segunda columna de la misma fila Do While ws.Cells(currentRow, colIndex).Value <> "" Or ws.Cells(currentRow, 1).Value <> "" ws.Cells(currentRow, 2).Value = ws.Cells(currentRow, colIndex).Value ws.Cells(currentRow, colIndex).ClearContents currentRow = currentRow + 1 Loop End If Next celda MsgBox "Las celdas debajo de 'Cantidad Pedida' han sido trasladadas a la segunda columna." End Sub

Pon un ejemplo de lo que quieres

A mi me pasó lo mismo, no lo entendí