Enviando datos de un archivo a otro vía macro en Calc

preguntado 2018-08-05 03:50:06 +0200

Imagen Gravatar de Qfito

updated 2018-08-06 22:39:44 +0200

Hola buen día a todos!

Me gustaría solicitar su ayuda para saber cuál sería el código equivalente de LibreOffice Basic para poder realizar esta tarea:

  1. Se almacenaran en un directorio un archivo Destino y varios archivos de Excel que servirían como Origen
  2. Cada archivo de Excel origen tendrá varias columnas por hoja y varias hojas por libro
  3. Copiar el contenido de algunas columnas de las diferentes hojas de los archivos Origen al archivo Destino
  4. Separar en hojas en el archivo Destino el contenido de las columnas seleccionadas en las hojas de los archivos Origen

Tengo algunos codigos en VBA de Excel pero quiero trasladarlo a LibreOffice.

VBA Code:

Sub extraerDatosOtroLibro()
      Dim wbLibroOrigen As Workbook
      Dim wsHojaOrigen As Worksheet

      Dim wbLibroDestino As Workbook
      Dim wsHojaDestino As Worksheet

      Dim Ruta As String

      Ruta = "E:\Documents\Excel\RVTools_tvdellsfesa01.xlsx"

      'Datos destino

      Set wbLibroDestino = Workbooks(ThisWorkbook.Name)
      Set wsHojaDestino = wbLibroDestino.Worksheets("Servidor Virtual")


      'Datos origen

      Set wbLibroOrigen = Workbooks.Open(Ruta)
      Set wsHojaOrigen = wbLibroOrigen.Worksheets("vInfo")

        uFila = wsHojaOrigen.Range("A" & Rows.Count).End(xlUp).Row
        wsHojaOrigen.Range("A2:BJ" & uFila).Copy Destination:=wsHojaDestino.Range("A2")
        Workbooks(wbLibroOrigen.Name).Close SaveChanges:=False

 End Sub

El siguiente código hace lo mismo, es decir extrae la información pero de varios libros de Excel excepto que si los libros origen tienen varias hojas con múltiples filas y columnas, no se trae todo ni tampoco el código permite extraer información de columnas específicas.

VBA Code:

Option Explicit
Dim nArchivo As Integer, Conteo As Integer, i As Integer, j As Integer, n As Integer
Sub ImportarData()

Call ContarArchivos

Application.ScreenUpdating = False
Dim WorkBookOrigen As Workbook
    Dim wsOrigen As Excel.Worksheet, _
    wsDestino As Excel.Worksheet, _
    rngOrigen As Excel.Range, _
    rngDestino As Excel.Range, _
    NombreArchivo As String, _
    Carpeta As String

    Carpeta = ActiveWorkbook.Path & "\"

nArchivo = 1

NombreArchivo = Dir(Carpeta & "RVTools_" & "*.xl*")


Do While Len(NombreArchivo) > 0



        Set WorkBookOrigen = Workbooks.Open(Carpeta & NombreArchivo)

            NombreArchivo = Dir()

        ThisWorkbook.Activate

        Set wsOrigen = WorkBookOrigen.Worksheets(1)
        Set wsDestino = Worksheets(1)

        Const celdaOrigen = "A2"

        Set rngOrigen = wsOrigen.Range(celdaOrigen)

        wsOrigen.Activate
        rngOrigen.Select
        Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy

Errores:
        If Err.Number = 1004 Then
            wsOrigen.Activate
            rngOrigen.Select
            Range(Selection, Selection.End(xlToRight)).Select
            Selection.Copy
        End If

            For n = 1 To 1
            wsDestino.Activate

On Error GoTo Errores

                wsDestino.Cells(Columns.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Next n
            Application.CutCopyMode = False

        WorkBookOrigen.Save
        WorkBookOrigen.Close

        nArchivo = nArchivo + 1

    Call Progreso


Loop

j = nArchivo - 1


Application.ScreenUpdating = True


MsgBox j & " Archivos procesados"

End Sub
Public Sub Progreso()
Dim Contador As Integer
Dim Maximo As Integer
Dim Mitiempo As Double



Maximo = nArchivo - 1

For Contador = 1 To Maximo Step 1
    Mitiempo = Timer
    Do
        Loop While Timer - Mitiempo < 0.02
        Application.StatusBar = "Progreso: " & Maximo & _
        " de " & i & " (" & Format(Maximo / i, "Percent") & ")"
    DoEvents
Next Contador

Application.StatusBar = False
End Sub
Public Sub ContarArchivos()
Dim cNombreArchivo, cCarpeta As String


cCarpeta = ActiveWorkbook ...
(more)
edit re-etiquetar marcar como ofensivo cerrar fusionar delete