Pegar datos de varias columnas de una hoja a otra hoja

Solo consultas sobre macros y código VBA Excel.
Reglas del Foro 1. Antes de hacer tu pregunta intenta con el buscador de este foro (muchas preguntas ya fueron respondidas antes!)
2. Si haces una nueva pregunta, es muy recomendable que adjuntes el ejemplo Excel para poder comprenderla mejor!
3. Realiza tu pregunta de forma clara, explicando bien cada paso de lo que haces y tendrás más probabilidad de respuesta!

Pegar datos de varias columnas de una hoja a otra hoja

Notapor Carlos2020 » 07 Oct 2018 03:21

Buenas a todos y gracias por vuestra paciencia de antemano. Soy novato no, lo siguiente, vba y yo no somos nada amigos y por mas que lo intento no lo consigo, me suena todo a chino. Decir que soy camionero y nutricionista, así que no tengo ni idea de estas cosas, solo de fórmulitas sencillas de excel.

Al grano, tengo una hoja llamada "calculos recetas" (columna N a la BR) (filas 2 a 267) en la que tengo unas fórmulas condicionales y de buscarV que recogen datos de otra hoja llamada "resumen".

hoja Origen "calculos recetas"

Columna N = dato 1; Columna O = cantidad del dato 1; Columna P = Unidad del dato 1
Columna Q = dato 2; Columna R = cantidad del dato 2; Columna S = Unidad del dato 2
Columna T = dato 3; Columna U = cantidad del dato 3; Columna V = Unidad del dato 3
Columna W = dato 4; Columna X = cantidad del dato 4; Columna Y = Unidad del dato 4
Columna Z = dato 5; Columna AA = cantidad del dato 5; Columna AB = Unidad del dato 5
Columna AC = dato 6; Columna AD = cantidad del dato 6; Columna AE = Unidad del dato 6
Columna AF = dato 7; Columna AG = cantidad del dato 7; Columna AH = Unidad del dato 7
Columna AI = dato 8; Columna AJ = cantidad del dato 8; Columna AK = Unidad del dato 8
Columna AL = dato 9; Columna AM = cantidad del dato 9; Columna AN = Unidad del dato 9
Columna AO = dato 10; Columna AP = cantidad del dato 10; Columna AQ = Unidad del dato 10
Columna AR = dato 11; Columna AS = cantidad del dato 11; Columna AT = Unidad del dato 11
Columna AU = dato 12; Columna AV = cantidad del dato 12; Columna AW = Unidad del dato 12
Columna AX = dato 13; Columna AY = cantidad del dato 13; Columna AZ = Unidad del dato 13
Columna BA = dato 14; Columna BB = cantidad del dato 14; Columna BC = Unidad del dato 14
Columna BD = dato 15; Columna BE = cantidad del dato 15; Columna BF = Unidad del dato 15
Columna BG = dato 16; Columna BH = cantidad del dato 16; Columna BI = Unidad del dato 16
Columna BJ = dato 17; Columna BK = cantidad del dato 17; Columna BL = Unidad del dato 17
Columna BM = dato 18; Columna BN = cantidad del dato 18; Columna BO = Unidad del dato 18
Columna BP = dato 19; Columna BQ = cantidad del dato 19; Columna BR = Unidad del dato 19

Lo que necesito es que el resultado de los datos de la hoja origen "calculos recetas" me los pase a otra hoja destino llamada "calculos ingredientes" y que se queden en 3 columnas únicamente, comenzando por la columna A1, es decir, que quedara de esta forma:

hoja destino "calculos ingredientes"

Columna A = solo datos Columna B = solo cantidades Columna C = solo unidades

Decir que en la hoja de destino "calculos ingredientes" se quedarán filas vacías con lo que sería recomendable que no se mostraran, ya que se quedaría en 5054 filas y tengo que seguir con cálculos y fórmulas a raíz de los resultados obtenidos.

Los datos de la hoja Origen "calculos recetas" pueden ser repetidos con lo quiero que aparezcan también.

He probado varias macros encontradas por internet pero no hacen lo que necesito, y programarla no sabría hacerlo. Espero me podáis ayudar. Gracias de antemano.
No tiene los permisos requeridos para ver los archivos adjuntos a este mensaje.
Carlos2020
Miembro Frecuente
Miembro Frecuente
 
Mensajes: 5
Registrado: 06 Oct 2018 04:28

Re: Pegar datos de varias columnas de una hoja a otra hoja

Notapor Haplox » 09 Oct 2018 07:46

Qué tal carlos2020,

Te dejo una solución a lo que necesitas. Prueba y comenta
No tiene los permisos requeridos para ver los archivos adjuntos a este mensaje.
Haplox
Miembro Frecuente
Miembro Frecuente
 
Mensajes: 41
Registrado: 01 Mar 2017 07:42

Re: Pegar datos de varias columnas de una hoja a otra hoja

Notapor Carlos2020 » 10 Oct 2018 03:55

Gracias por tu pronta solución, funciona perfectamente, eres un crack. Lástima que al implantarlo en mi libro no funcione correctamente. Fallo mío al pensar que con copy paste tendría la solución. Ya dije que novato no, lo siguiente. Te adjunto el archivo original y el código implantado. A ver, que seguro es una simpleza.

Lo que falla es que el boton que ejecuta la macro esta en otra hoja distinta, y al mismo tiempo ejecuta otra macro distinta, La idea es que en un solo boton se ejecuten ambas macros de forma seguida.

Código: Seleccionar todo

Sub Importar_Datos()
    '
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Valores")
    Set h2 = l1.Sheets("Resumen")
    h2.Cells.ClearContents
    '
    ruta = h1.[B5]
    hoja = h1.[B6]
    fila = h1.[B7]
    colu = h1.[B8]
    '
    mensaje = validaciones(ruta, hoja, fila, colu)
    If mensaje <> "" Then
        MsgBox mensaje, vbExclamation, "IMPORTAR ARCHIVOS"
        Exit Sub
    End If
    '
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.StatusBar = False
    Application.Calculation = xlCalculationManual
    '
    If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
    arch = Dir(ruta & "*.xls*")
    i = 0
    Do While arch <> ""
        i = i + 1
        Application.StatusBar = "Importando Libro : " & i & " de : " & N
        Set l2 = Workbooks.Open(ruta & arch)
        existe = False
        If IsNumeric(hoja) Then
            If l2.Sheets.Count >= hoja Then
                existe = True
                Set h22 = l2.Sheets(hoja)
            Else
                     
            End If
        Else
            For Each H In l2.Sheets
                If LCase(H.Name) = LCase(hoja) Then
                    existe = True
                    Set h22 = l2.Sheets(hoja)
                    Exit For
                End If
            Next
        End If
        '
        If existe Then
            u22 = h22.Range(colu & Rows.Count).End(xlUp).Row
            u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
            h22.Rows(fila & ":" & u22).Copy
            h2.Range("A" & u2).PasteSpecial xlValues
        End If
        '
        l2.Close False
        arch = Dir()
    Loop
    '
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.StatusBar = False
    Application.Calculation = xlCalculationAutomatic
    '
    '
    ' - ---------------------------------------- copiar ingredientes
    '
    '
    Dim nCol As Long, nFil As Long
    Dim datos()
    Dim x%, c%, f%
    '
    nCol = Sheets("calculos recetas").Cells(1, Columns.Count).End(xlToLeft).Column + 2
    nFil = Sheets("calculos recetas").Range("N" & Rows.Count).End(xlUp).Row
    '
    ReDim datos(1 To (nCol * nFil), 1 To 3)
    x = 1
    '
    For c = 15 To nCol Step 3
        For f = 2 To nFil
            If Cells(f, c) <> "" Then
            datos(x, 1) = Cells(f, c)
            datos(x, 2) = Cells(f, c + 1)
            datos(x, 3) = Cells(f, c + 2)
            x = x + 1
            End If
        Next
    Next
    '
    With Sheets("calculos ingredientes")
        .Cells(1, 1) = "Nombre": .Cells(1, 2) = "Cantidad": .Cells(1, 3) = "Unidad"
        .Cells(2, 1).Resize(x, 3) = datos
    End With
    '
    Erase datos
    '
    '
    ' - ------------------------------------------------ fin copiar ingredientes
    '
    '
    '
    MsgBox "Proceso terminado, archivos importados correctamente", vbInformation, "IMPORTAR ARCHIVOS"
End Sub

No tiene los permisos requeridos para ver los archivos adjuntos a este mensaje.
Carlos2020
Miembro Frecuente
Miembro Frecuente
 
Mensajes: 5
Registrado: 06 Oct 2018 04:28

Re: Pegar datos de varias columnas de una hoja a otra hoja

Notapor Carlos2020 » 10 Oct 2018 04:50

SOLUCIONADO !!!!!!!!!!!!!!!!!!!!!

Mil millones de gracias de nuevo, ahora puedo continuar. Solo he tenido que hacer unas pequeñas modificaciones para adaptar tu codigo dentro del mio. Dejo los aportes.

Código: Seleccionar todo

Sub Importar_Datos()
    '
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Valores")
    Set h2 = l1.Sheets("Resumen")
    Set h3 = l1.Sheets("calculos recetas")
    Set h4 = l1.Sheets("calculos ingredientes")
    h2.Cells.ClearContents
    h4.Cells.ClearContents
    '
    ruta = h1.[B5]
    hoja = h1.[B6]
    fila = h1.[B7]
    colu = h1.[B8]
    '
    mensaje = validaciones(ruta, hoja, fila, colu)
    If mensaje <> "" Then
        MsgBox mensaje, vbExclamation, "IMPORTAR ARCHIVOS"
        Exit Sub
    End If
    '
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.StatusBar = False
    Application.Calculation = xlCalculationManual
    '
    If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
    arch = Dir(ruta & "*.xls*")
    i = 0
    Do While arch <> ""
        i = i + 1
        Application.StatusBar = "Importando Libro : " & i & " de : " & N
        Set l2 = Workbooks.Open(ruta & arch)
        existe = False
        If IsNumeric(hoja) Then
            If l2.Sheets.Count >= hoja Then
                existe = True
                Set h22 = l2.Sheets(hoja)
            Else
                     
            End If
        Else
            For Each H In l2.Sheets
                If LCase(H.Name) = LCase(hoja) Then
                    existe = True
                    Set h22 = l2.Sheets(hoja)
                    Exit For
                End If
            Next
        End If
        '
        If existe Then
            u22 = h22.Range(colu & Rows.Count).End(xlUp).Row
            u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
            h22.Rows(fila & ":" & u22).Copy
            h2.Range("A" & u2).PasteSpecial xlValues
        End If
        '
        l2.Close False
        arch = Dir()
    Loop
    '
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.StatusBar = False
    Application.Calculation = xlCalculationAutomatic
    '
    '
    ' - ---------------------------------------- copiar ingredientes
    '
    '
    ActiveWorkbook.Sheets("calculos recetas").Activate
    '
    Dim nCol As Long, nFil As Long
    Dim datos()
    Dim x%, c%, f%
    '
    nCol = h3.Cells(1, Columns.Count).End(xlToLeft).Column + 2
    nFil = h3.Range("N" & Rows.Count).End(xlUp).Row
    '
    ReDim datos(1 To (nCol * nFil), 1 To 3)
    x = 1
    '
    For c = 15 To nCol Step 3
        For f = 2 To nFil
            If Cells(f, c) <> "" Then
            datos(x, 1) = Cells(f, c)
            datos(x, 2) = Cells(f, c + 1)
            datos(x, 3) = Cells(f, c + 2)
            x = x + 1
            End If
        Next
    Next
    '
    With h4
        .Cells(1, 1) = "Nombre": .Cells(1, 2) = "Cantidad": .Cells(1, 3) = "Unidad"
        .Cells(2, 1).Resize(x, 3) = datos
    End With
    '
    Erase datos
    '
    '
    ' - ------------------------------------------------ fin copiar ingredientes
    '
    '
    '
    MsgBox "Proceso terminado, archivos importados correctamente", vbInformation, "IMPORTAR ARCHIVOS"
End Sub

Carlos2020
Miembro Frecuente
Miembro Frecuente
 
Mensajes: 5
Registrado: 06 Oct 2018 04:28


Volver a Macros

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 7 invitados