Como copiar datos hacia abajo de pendiendo de la cantidad?
En la columna A tengo registros y en la columna B la cantidad de estos puede ser de 1 a 20 y en la columna C los que ya se procesaron, necesito pasarlos a otra hoja donde la cantidad son los datos que se pondrán hacia abajo pero respetando los procesados pongo imagen de ejemplo colocando en la misma hoja espero me ayuden de antemano muchas gracias
2 respuestas
Puedes usar esta macro:
Te irá añadiendo líneas a la Hoja2
Sub copiando()
With Hoja2
ufila = .Cells(Rows.Count, 1).End(xlUp).Row 'busca la ultima fila con datos en la columna 1 ("A")
ufila = ufila + 1
lin = 1
Do Until Cells(lin, 1) = "" 'bucle para cada linea de la hoja a copiar
For b = 1 To Cells(lin, 2) 'numero de repeticiones de cada registro según el dato de la 'columna 2 ("B")
.Cells(ufila, 1) = Cells(lin, 1)
.Cells(ufila, 2) = 1
If b > Cells(lin, 3) Then 'pone 1 ó 0 según el dato de la columna 3
.Cells(ufila, 3) = 0
Else
.Cells(ufila, 3) = 1
End If
ufila = ufila + 1
Next b
lin = lin + 1
Loop
End With
End Sub
Hola que tal agradezco tu tiempo para contestarme, pero el código en la línea
ufila = .Cells(Rows.Count, 1).End(xlUp).Row genera un error quitando el punto que esta en .cells avanza pero se detiene en el For por incompatibilidad, podrás orientarme para poder corregir el error
El punto hace referencia a la hoja2 . Se activa en la linea "with Hoja2" hasta la que pone "end With"
En ese intervalo el "." equivale a poner "hoja2. "
Se supone que tienes tus datos en la Hoja1 y los quieres copiar a la Hoja2. Si quieres utilizar el nombre de la hoja (el que aparece en la pestaña de abajo) cambia Hoja2 por Sheets("Nombredelahoja")
El error que te da en el For seguramente es porque tienes los datos como texto en las columnas B y C
Para evitarlo cambia en la linea donde pone For b = 1 To Cells(lin, 2)
pon: For b = 1 To Val(Cells(lin, 2) ) .
Y lo mismo en donde pone "If b > Cells(lin, 3) Then " cambialo por
If b > ValCells(lin, 3) Then
Espero que se solucione, yo lo he probado antes de enviarlo.
Nuevamente un agradecimemiento y solicitando más consejo, son la refencia que me mencionas (with sheet2) y los puntos no quiere funcionar de hecho en mi hoja 1 al final de los datos es donde me copia nuevamente y me pasa los datos desglosados
Espero me puedas ayudar
Saludos muchas gracias!
Debes tener algún error al nombrar la hoja. Puedes poner : Hoja2 (sin comillas) ó
El nombre de la hoja, pero en este caso tienes que ponerlo así: Sheets("Resumen").
Te pongo imagen de los dos ejemplos, cambialos por los que aparezcan en tu proyecto.
Te paso la macro
Sub COPIAR()
'
'VALORA LA RESPUESTA PARA FINALIZAR
Set h1 = Sheets("Datos")
Set h2 = Sheets("Resumen")
'
h1.Range("A1:C1").Copy h2.Range("A1")
h2.Range("A2:C" & Rows.Count).ClearContents
'
u = h1.Range("A" & Rows.Count).End(xlUp).Row
n = 0
k = 2
For i = 2 To u
nmax = h1.Cells(i, "C")
For j = 1 To h1.Cells(i, "B")
h2.Cells(k, "A") = h1.Cells(i, "A")
h2.Cells(k, "B") = 1
If n < nmax Then h2.Cells(k, "C") = 1 Else: h2.Cells(k, "C") = 0
k = k + 1
n = n + 1
Next j
n = 0
Next i
h2.Select
'
MsgBox "Fin"
End Sub