Como copiar una fila de un libro a otro

Dante Amor Esta pregunta va dirigida a ti, pero si alguien mas pudiera aportar seria bienvenido.

Deseo copiar una fila completa que se selecciona en un listbox y al apretar un botón eliminar, se elimina del listbox y de la hoja10. Hasta ahí todo va bien pero ahora quisiera que antes de eliminarla copiara esta fila seleccionada y la pegara en otro libro (Hoja1) en la ultima fila vacía indicando en la ultima columna vacía la hora y fecha del copiado. Anexo macro actual para eliminar. Espero haberme explicado. Agradezco su atención

Sub eliminarProducto()
    Dim Dato As String
    Dim C As Range
    Dim uf As Long
    uf = Hoja10.Range("A" & Rows.Count).End(xlUp).Row
    With ListBox1
       For x = 0 To .ListCount - 1
          If .Selected(x) Then
              Dato = ListBox1.Text
                  With Hoja10.Range("A2:A" & uf)
                  Set C = .Find(Dato, LookIn:=xlValues, lookat:=xlWhole)
                    If Not C Is Nothing Then
'AQUI ES DONDE QUIERO SE EJECUTE LO SOLICITADO ANTES DE ELIMINAR
                        C.Rows.EntireRow.Delete
                        UserForm_Initialize
                        MsgBox "Ha eliminado la clave  " & Dato
                        Exit Sub
                     End If
                  End With
          End If
       Next
    End With
End Sub

1 respuesta

Respuesta
1

Adapté el código, no lo he probado pero debería funcionarte. Asegúrate de leer el par de comentarios que puse, debes modificar la ruta del libro destino, y el nombre de la hoja. Veo que sabes algo de VBA, te sera fácil adaptarlo. En general esta es la idea:

Sub eliminarProducto()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
'modificacion, nuevas variables'
Dim EsteLibro As Workbook: Set EsteLibro = ThisWorkbook
Dim OtroLibro As Workbook
Dim Sht1 As Worksheet
Dim uC As Long
Dim RowArr() As Variant
'Andy'
    Dim Dato As String
    Dim C As Range
    Dim uf As Long
    uf = Hoja10.Range("A" & Rows.Count).End(xlUp).Row
    With ListBox1
       For x = 0 To .ListCount - 1
          If .Selected(x) Then
              Dato = ListBox1.Text
                  With Hoja10.Range("A2:A" & uf)
                  Set C = .Find(Dato, LookIn:=xlValues, lookat:=xlWhole)
                    If Not C Is Nothing Then
                    'AQUI ES DONDE QUIERO SE EJECUTE LO SOLICITADO ANTES DE ELIMINAR'
                    'modificacion, nuevo procedimiento'
                        uC = Cells(C.Row, Columns.Count).End(xlToLeft).Column
                        RowArr() = Range(Cells(C.Row, 1), Cells(C.Row, uC)).Value2
                        Set OtroLibro = Workbooks.Open("C:\Carpeta\Sub Carpeta\Otra Carpeta\NombreLibro.xls") 'modifica la ruta'
                        Set Sht1 = OtroLibro.Sheets("Sheet1") 'modifica el nombre de la hoja'
                        uf = Sht1.Range("A" & Rows.Count).End(xlUp).Row + 1
                        Sht1.Range(Cells(uf, 2), Cells(uf, uC)).Value = RowArr()
                        Sht1.Cells(uf, uC + 1).Value = Now
                        Sht1.Cells(uf, uC + 1).NumberFormat = "mm/dd/yyyy - hh:mm:ss AM/PM"
                        OtroLibro.Close SaveChanges:=True
                    'Andy'
                        C.Rows.EntireRow.Delete
                        UserForm_Initialize
                        MsgBox "Ha eliminado la clave  " & Dato
                        Exit Sub
                     End If
                  End With
          End If
       Next
    End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub

Andy

Andy Machin Muchísimas gracias, le hice algunas adecuaciones pero jalo al 100. quedando así.

                    'modificacion, por Andy'
                        uC = Cells(C.Row, Columns.Count).End(xlToLeft).Column
                        RowArr() = Range(Cells(C.Row, 1), Cells(C.Row, uC)).Value2
                        Set OtroLibro = Workbooks.Open(ThisWorkbook.Path & "\Libro2.xlsm")  'abrir el archivo en cualquier escritorio
                        Set Sht1 = OtroLibro.Sheets("Hoja1") 'nombre de la hoja'
                        uf = Sht1.Range("A" & Rows.Count).End(xlUp).Row + 1
                        Sht1.Range(Cells(uf, 1), Cells(uf, uC)).Value = RowArr()
                        Sht1.Cells(uf, uC + 1).Value = Now
                        Sht1.Cells(uf, uC + 1).NumberFormat = "mm/dd/yyyy - hh:mm:ss AM/PM"
                        OtroLibro.Close SaveChanges:=True

Perfecto, a la orden :)

PD: no olvide que las preguntas se cierran con "agradecimiento" en lugar de "Pedir más información" de lo contrario se queda abierta como si aun no fuera resuelta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas