Saltar al contenido

Copiar rango de acuerdo cada dterminada cantidad de columns

publicado

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

Featured Replies

publicado

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]

publicado
  • Autor

Gracias Armando Intentaré hacerlo.

te cuento cómo me fue luego.

publicado

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]

publicado
  • Autor

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.

publicado
  • Autor

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

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.