Copiar solo columnas según dia

[Potter08]

Hola buenas noches me podrian ayudar con este archivo ejemplo, necesito copiar en hoja resumen los ingresos por dias y las salidas por dia en hojas resumen de tabla de control de inventarios, espero sus comentario gracias.

adjunto ejemplo y un intento de macro pero me he quedado trabado explicación en archivo modulo vba

de antemano gracias, salu2

Ejemplo Resumen.xls

[Armando Montes]

Hola, asumiendo que quieres copiar los 6 dias y el total, intenta con esto:

Sub Copiar()

Application.ScreenUpdating = False

  With Sheet2.[A9].CurrentRegion

  .Copy Sheet1.[A9]

  .Copy Sheet3.[A9]

  End With

  Sheet1.Activate

  For j = 14 To 4 Step -2

  Columns(j).Delete

  Next

  Range("I11:I23").Formula = "=SUM(C11:H11)"

  Sheet3.Activate

  For j = 13 To 3 Step -2

  Columns(j).Delete

  Next

  Range("I11:I23").Formula = "=SUM(C11:H11)"

  Sheet2.Activate

Application.ScreenUpdating = True

End Sub

    [/CODE]

[Antoni]

Ayudaría que en el archivo pusieras el resultado esperado en las hojas RESUMEN INGRESO y RESUMEN SALIDA.

[Potter08]

Si, gracias por responder ( Armando y Macro ) y las disculpas del caso por no poner el ejemplo de como queria los datos aqui subo de nuevo el ejemplo ya con el dato como tendria que aparecer. con la macro de Armando esta interezante la estudiare a ver si la ocupo en otro archivo gracias.

Salu2

Ejemplo Resumen.xls

[logroastur]

Buenas utiliza

Sub GeneraResumen()
    Dim f   As Long
    Dim c   As Long
    Dim uf  As Long
    Dim uc  As Long
    Dim x   As Range
    Dim y   As Range
    Dim i   As Long
    With Sheets("control")
        uf = .Range("A50000").End(xlUp).Row
        If uf < 11 Then Exit Sub
        uc = .Range("A10").End(xlToRight).Column
        If uf < 2 Then Exit Sub
        For f = 11 To uf
            Set x = Sheets("Resumen Ingreso").Range("A" & 50000).End(xlUp)(2)
            Set y = Sheets("Resumen Salida").Range("A" & 50000).End(xlUp)(2)
            x = .Range("A" & f)
            y = .Range("A" & f)
            x.Offset(0, 1) = .Range("B" & f)
            y.Offset(0, 1) = .Range("B" & f)
            Sheets("Resumen Ingreso").Cells(1, x.Offset(0, 1).Column) = "ACTUAL"
            Sheets("Resumen Salida").Cells(1, x.Offset(0, 1).Column) = "ACTUAL"
            i = 1
            For c = 3 To uc Step 2
                i = i + 1
                Sheets("Resumen Ingreso").Cells(1, x.Offset(0, i).Column) = .Cells(9, c)
                Sheets("Resumen Salida").Cells(1, x.Offset(0, i).Column) = .Cells(9, c)
                x.Offset(0, i) = .Cells(f, c)
                y.Offset(0, i) = .Cells(f, c + 1)
            Next c
            x.Offset(0, i + 1) = WorksheetFunction.Sum(Range(x.Offset(0, 2), x.Offset(0, i)))
            y.Offset(0, i + 1) = WorksheetFunction.Sum(Range(y.Offset(0, 2), y.Offset(0, i)))
            Sheets("Resumen Ingreso").Cells(1, x.Offset(0, i + 1).Column) = "TOTAL"
            Sheets("Resumen Salida").Cells(1, x.Offset(0, i + 1).Column) = "TOTAL"
            Set x = Nothing
            Set y = Nothing
        Next f
    End With
End Sub

Un saludo

[Potter08]

Gracias , logroastur pero quiza puse muy tarde una nueva explicacion de lo que necesito y adjunte en un nuevo mensaje las disculpas este inconveniente.

salu2

[Antoni]

____________________________________________________________________

Sub Resumen()

Dim INGRESO, SALIDA, CONTROL, x, y, FilaI, FilaS


Set INGRESO = Sheets("RESUMEN INGRESO")

Set SALIDA = Sheets("RESUMEN SALIDA")

Set CONTROL = Sheets("CONTROL")


FilaI = 2:                       FilaS = 2

INGRESO.Cells.Clear:             SALIDA.Cells.Clear

INGRESO.Range("A1") = "DÍA":     SALIDA.Range("A1") = "DÍA"

INGRESO.Range("B1") = "CÓDIGO":  SALIDA.Range("B1") = "CÓDIGO"

INGRESO.Range("C1") = "INGRESO": SALIDA.Range("C1") = "SALIDA"


For y = 3 To 13 Step 2

  For x = 11 To CONTROL.Range("A" & Rows.Count).End(xlUp).Row

      If Not Trim(CONTROL.Cells(x, y)) = Empty Then

         INGRESO.Range("A" & FilaI) = CONTROL.Cells(9, y)

         INGRESO.Range("B" & FilaI) = CONTROL.Cells(x, 1)

         INGRESO.Range("C" & FilaI) = CONTROL.Cells(x, y)

         FilaI = FilaI + 1

      End If

      If Not Trim(CONTROL.Cells(x, y + 1)) = Empty Then

         SALIDA.Range("A" & FilaS) = CONTROL.Cells(9, y)

         SALIDA.Range("B" & FilaS) = CONTROL.Cells(x, 1)

         SALIDA.Range("C" & FilaS) = CONTROL.Cells(x, y + 1)

         FilaS = FilaS + 1

      End If

  Next

Next


End Sub

[/CODE]

_____________________________________________________________

[Potter08]

Excelente trabajo Macro Antonio, es la solucion correcta gracias, y a todos por participar

Consulta finalizada.

Salu2.xlsx