Copiar rango de acuerdo cada dterminada cantidad de columns

[celim]

Estimados amigos, esxribo para pedirles una mano y me ayuden a solucionar este problema que tengo.

quiero copiar de una tabla cuyo rango es variable la cantidad aproximada de 9 columnas.

y ademas de las dos primeras .

estas deben ser copiadas hacia abajo de la base de datos tal como indica la hoja "Model" del libro que adjunto.

Gracias por su apoyo desde ya.

Copiar rango_por determinada cant_columns.zip

[Armando Montes]

Hola, no puedo adaptarlo en este momento pero este codigo hace lo que necesitas, el pero que deberas adaptar/complementar es que usa una hoja diferente para cada grupo.

Lo que puedes hacer facilmente es copier esas hojas a una sola.

Sub ColumnsToSheets()

Dim wsData  As Worksheet  'Sheet with data to parse

Dim FirstCol As Long        'This is the first column to transfer

Dim ColCnt  As Long        'This is how many columns in a group to transfer

Dim LastCol  As Long        'check row1 to see how many columns of data there are

Dim NewSht  As Long        'how many new sheets will be created


FirstCol = Application.InputBox("Which column is the first 'data column' to transfer?" _

    & vbLf & "(A=1, B=2, C=3, etc...)" _

    & vbLf & "(All columns to the left will appear on every sheet)", _

    "First Data Column", 2, Type:=1)

If FirstCol = 0 Then Exit Sub


ColCnt = Application.InputBox("How many data columns are in each group?", _

    "Groups of Columns", 1, Type:=1)

If ColCnt = 0 Then Exit Sub


Set wsData = ActiveWorkbook.Sheets("Sheet1")

Application.ScreenUpdating = False


With wsData

    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

    For NewSht = FirstCol To LastCol Step ColCnt

        Sheets.Add , After:=Sheets(Sheets.Count)

        .Columns(1).Resize(, FirstCol - 1).Copy Range("A1")

        .Columns(NewSht).Resize(, ColCnt).Copy Cells(1, FirstCol)

    Next NewSht

End With


Application.ScreenUpdating = True

End Sub[/CODE]

[celim]

Gracias Armando Intentaré hacerlo.

te cuento cómo me fue luego.

[Armando Montes]

En la consulta mencionas 9 columnas y en el ejemplo muestras 21, el codigo esta para 21:

Sub aaa()

Application.ScreenUpdating = False

For i = 3 To [A4].CurrentRegion.Columns.Count Step 21

LR = Range("C" & Rows.Count).End(xlUp).Row + 3

[A4:B13].Copy Range("A" & LR)

Range(Cells(4, i), Cells(13, i)).Resize(, 21).Copy Range("C" & LR)

'Columns(I).Select

Next

Application.ScreenUpdating = True

End Sub[/CODE]

[celim]

Gracias estimado, Armando.

efectivamente yo quiero que se copien cada 9 columnas, por ello realice una pequeña modificación al último código que me enviast reemplazando el Nro 21 por el 9 y funcionó.

tal como yo buscaba.

El primer código funciona,sin embargo crea hojas nuevas y eso no el objetivo.

por lo que con el último codigo quedo perfecto.

de verdad mil gracias...Maestro.

[celim]

por otro lado Armando tiene ud. razón al decir que la consulta es distinta a la hoja modelo.mil disculpas por el error.

[Armando Montes]

Gracias por avisar.

SOLUCIONADO