Saltar al contenido
View in the app

A better way to browse. Learn more.

Ayuda Excel

A full-screen app on your home screen with push notifications, badges and more.

To install this app on iOS and iPadOS
  1. Tap the Share icon in Safari
  2. Scroll the menu and tap Add to Home Screen.
  3. Tap Add in the top-right corner.
To install this app on Android
  1. Tap the 3-dot menu (⋮) in the top-right corner of the browser.
  2. Tap Add to Home screen or Install app.
  3. Confirm by tapping Install.

VBA- EXCEL - No puedo pegar mis datos en otra hoja

publicado

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

 

Featured Replies

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

Configure browser push notifications

Chrome (Android)
  1. Tap the lock icon next to the address bar.
  2. Tap Permissions → Notifications.
  3. Adjust your preference.
Chrome (Desktop)
  1. Click the padlock icon in the address bar.
  2. Select Site settings.
  3. Find Notifications and adjust your preference.