Mi codigo esta funcionando al 90% ya que cuando estoy por finalizarlo, y deseo pegar datos que copie previamente de otra hoja, el codigo se interrumpe y no encuentro manera de dejarlo funcional.

Estoy copiando datos de la hoja "Tabla1" y los estoy pegando en un libro llamado "REPORTE CC_MACRO" en la hoja "tabla base".

El codigo se interrumpe en

 

    ' 3. Una vez seleccionada la celda D3, pegar los datos que se copiaron en pasos anteriores
    Selection.PasteSpecial Paste:=xlPasteValues

Codigo completo:

 

Sub BASEV1OK()
    Dim wsOrigen As Worksheet
    Dim wsOrigen2 As Worksheet
    Dim wsDestino As Worksheet
    Dim rngOrigen As Range
    Dim rngDestino As Range
    Dim rngOrigen2 As Range
    Dim ultFila As Long
    
    ' Definir la hoja de trabajo Original -    Dim wsOrigen As Worksheet
    Set wsOrigen = ThisWorkbook.Sheets("original")
    
    ' Obtener la última fila en la columna S -     Dim ultFila As Long
    ultFila = wsOrigen.Cells(wsOrigen.Rows.Count, "S").End(xlUp).Row
    

'    ----------------------------
    
'' RANGO PARA ORDENAR COLUMNAS A O P - Definir el rango de datos de origen excluyendo la primera fila y limitando hasta la columna S
'Set rngOrigen = wsOrigen.Range("A2", wsOrigen.Cells(wsOrigen.Rows.Count, "S").End(xlUp))
    
    ' RANGO PARA ORDENAR COLUMNAS A O P - Definir el rango de datos de origen excluyendo la primera fila y limitando hasta la columna S
    Set rngOrigen = wsOrigen.Range("A2:S" & ultFila)


     
    
    ' Ordenar por las columnas A, O y P de menor a mayor
    MsgBox "Ordenando datos por las columnas A, O y P..."
    With rngOrigen
        .Sort Key1:=.Columns("A"), Order1:=xlAscending, _
              Key2:=.Columns("O"), Order2:=xlAscending, _
              Key3:=.Columns("P"), Order3:=xlAscending, _
              Header:=xlYes
    End With
    
    MsgBox "Ordenación completada."
    
'    ----------------------------
    
    'RANGO PARA FILTRAR COLUMNAS Definir el rango de datos de origen excluyendo la primera fila
    Set rngOrigen2 = wsOrigen.Range("A1", wsOrigen.Cells(wsOrigen.Rows.Count, "A").End(xlUp).Offset(, wsOrigen.Cells(1, wsOrigen.Columns.Count).End(xlToLeft).Column))
    
    
   ' Aplicar filtro en la columna R
MsgBox "Aplicando filtro en la columna R..."
With rngOrigen2

    ' Limpiar filtros existentes
    .AutoFilter
    
' Aplicar filtro personalizado en la columna R
rngOrigen2.AutoFilter Field:=18, Criteria1:=Array("** Sin Uso **", "Clientes en mora", "En Juicio", "Sin Operar"), Operator:=xlFilterValues

End With

MsgBox "Filtro aplicado."

'    ----------------------------


' Seleccionar las celdas visibles después de aplicar el filtro
On Error Resume Next ' Ignorar error si no hay celdas visibles
Dim rngFiltrado As Range
Set rngFiltrado = rngOrigen.SpecialCells(xlCellTypeVisible) ' SE TOMA EL RANGO SIN LOS TITULARES PARA QUE NO LO ELIMINE
On Error GoTo 0 ' Restaurar manejo normal de errores

' Verificar si se encontraron celdas visibles
If Not rngFiltrado Is Nothing Then
    ' Eliminar las filas filtradas
    rngFiltrado.EntireRow.Delete
Else
    MsgBox "No se encontraron datos filtrados para eliminar.", vbInformation
End If

' Limpiar filtro
wsOrigen.AutoFilterMode = False

'    ----------------------------


'    ' Seleccionar todo el contenido activo de la hoja
'    rngOrigen.Copy

' Copiar solo las celdas desde A hasta S en lugar de todas las columnas
wsOrigen.Range("A2:N" & ultFila).Copy



    
    MsgBox "Tabla copiada"
    
    
        ' Crear una nueva hoja llamada "Tabla1"
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Tabla1"
    
'    ----------------------------

          ' Definir la hoja de trabajo Tabla1
    Set wsOrigen2 = ThisWorkbook.Sheets("Tabla1")
    
'    ----------------------------
    
        ' Definir la hoja de destino
    Set wsDestino = ThisWorkbook.Sheets("Tabla1")
    
    
'    ' Pegar los datos en la hoja de destino (solo las columnas A a S)
'wsDestino.Range("A1:N" & rngOrigen.Rows.Count).PasteSpecial Paste:=xlPasteValues
    
        ' Pegar los datos en la hoja de destino (solo las columnas A a S)
    wsDestino.Range("A1").PasteSpecial Paste:=xlPasteValues
    
    
    
        ' Limpiar el portapapeles
    Application.CutCopyMode = False
    
'    ' Eliminar la fila de títulos en la hoja de destino - NO SE USA YA QUE ESTOY PEGANDO TABLA SIN TITULOS
'    wsDestino.Rows(1).Delete
    
    ' Limpiar filtros en la hoja de origen
    wsOrigen.AutoFilterMode = False
    
    
    
'    ----------------------------
    
' ------Verificar si el archivo "REPORTE CC_MACRO" está abierto
    If WorkbookIsOpen("REPORTE CC _MACRO.xlsm") Then
    
        Dim wsReporte As Worksheet
        Set wsReporte = Workbooks("REPORTE CC _MACRO.xlsm").Sheets("Tabla Base")
                   
        
        ' 2. Si está abierto, activar la hoja "Tabla Base" y seleccionar la celda D3
        With wsReporte
            .Activate
            .Range("D3").Select
        End With
        
        
        ' 3. Una vez seleccionada la celda D3, pegar los datos que se copiaron en pasos anteriores
        Selection.PasteSpecial Paste:=xlPasteValues
        
        ' 4. Desactivar modo de copia
        Application.CutCopyMode = False
        
        
'         ' --------Pegar los datos desde el array al rango de destino
'        rngDestino.Resize(UBound(rngOrigen.Value, 1), UBound(rngOrigen.Value, 2)).Value = rngOrigen.Value
        
        
        ' 5. Mostrar mensaje de éxito
        MsgBox "Datos pegados exitosamente."
        
        ' 6. Mostrar mensaje si el archivo "REPORTE CC_MACRO" está cerrado
    Else
        MsgBox "El archivo 'REPORTE CC _MACRO.xlsm' no está abierto.", vbExclamation
    End If
End Sub

Function WorkbookIsOpen(workbookName As String) As Boolean
    Dim wb As Workbook
    On Error Resume Next
    Set wb = Workbooks(workbookName)
    WorkbookIsOpen = Not wb Is Nothing
    On Error GoTo 0
End Function

 

Sube tu archivo