none
Macro Copiar y pegar RRS feed

  • Pregunta

  • Hola,

    Tengo una gran cantidad de datos en una fila (5000 columnas aprox) estas columnas contienen datos Nombre/direccion/ID1/estado/comunidad y se van repitiendo.

    Quiero colocar todos esos datos en 5 columnas hacia abajo para poder tener más control sobre los datos (poder filtrar etc), el problema viene que hay algunos casos donde aparecen columnas con un 0.

    Había pensado en ir copiando cada 5 columnas y pegar en la ultima "linea" libre, pero el plan se jode cuando aparece una columna vacía o con el 0.

    Estoy bastante verde en Macros, espero que me podáis ayudar, Gracias.




    • Editado karlos78 jueves, 17 de enero de 2019 13:53
    jueves, 17 de enero de 2019 13:53

Todas las respuestas

  • Hola

    No nos comentas que versión de Office utilizas.

    Tendrás que localizar primero cual es la última columna. Para ello, usa una instrucción como esta:

    VariableWorkBook.Worksheets(i).Cells(4, 16384).End(xlToLeft).Column

    Luego, con ciclo FOR desde 1 hasta el valor recuperado de última columna, con un parámetro STEP de 5, saltas cada grupo de cinco columnas y las vas pegando en otra hoja por filas.

    Este procedimiento automatiza Excel desde Access. Se le pasa como parámetro el nombre y ruta de acceso del libro a tratar

    Public Sub prueba(sLibro As String)
        Dim MiExcel As Excel.Application, MiLibro As Excel.Workbook, MiHoja1 As Excel.Worksheet, MiHoja2 As Excel.Worksheet
        Set MiExcel = New Excel.Application
        Set MiLibro = MiExcel.Workbooks.Open(sLibro)
        Dim lX As Long, i As Integer, j As Integer
        
        If MiLibro.Worksheets.Count = 1 Then
            MiLibro.Worksheets.Add after:=MiLibro.Worksheets(1)
        End If
        Set MiHoja1 = MiLibro.Worksheets(1)
        Set MiHoja2 = MiLibro.Worksheets(2)
        'Empezadmos la inserción de datos en la segunda fila, para dejar la primera para nombre de encabezados
        j = 2
        'Recupero cual es la última columna con datos
        lX = MiHoja1.Cells(1, 16384).End(xlToLeft).Column
        
        For i = 1 To lX Step 5
            'Se supone que tenemos los datos en la fila 1
            MiHoja2.Cells(j, 1) = MiHoja1.Cells(1, i)
            MiHoja2.Cells(j, 2) = MiHoja1.Cells(1, i + 1)
            MiHoja2.Cells(j, 3) = MiHoja1.Cells(1, i + 2)
            MiHoja2.Cells(j, 4) = MiHoja1.Cells(1, i + 3)
            MiHoja2.Cells(j, 5) = MiHoja1.Cells(1, i + 4)
            j = j + 1
            DoEvents
        Next
        Set MiHoja1 = Nothing
        Set MiHoja2 = Nothing
        MiLibro.Application.DisplayAlerts = False
        MiLibro.Save
        MiLibro.Application.DisplayAlerts = True
        MiLibro.Close
        Set MiLibro = Nothing
        MiExcel.Quit
        Set MiExcel = Nothing
    End Sub

    No está probado, así que usalo sin ninguna garantía, y haz una copia previa de seguridad del fichero.

    Salu2,


    José Mª Fueyo

    • Propuesto como respuesta José Mª Fueyo viernes, 25 de enero de 2019 9:40
    miércoles, 23 de enero de 2019 9:17