Datos Hoja1 a Hoja2 incrementando el No. Veces el valor celdas columna B de la hoja1 a la hoja2

Se tiene una hoja1 con los siguientes datos:

IMPORTANTE: Ver comentarios INCLUIDOS en las hoja1 y hoja2

Resultado en hoja2:

Continuación resultado hoja2:

Así sucesivamente, hasta encontrar linea vacia en B de la hoja1

Nota: En las columnas E, F, G de la hoja2 son datos que no vienen de la hoja1 y se deben generar automáticamente por la macro.

1 respuesta

Respuesta
2

H o l a:

Bien por el ejemplo! Con las imágenes y una breve explicación es suficiente para comprender el ejercicio.

Te anexo la macro, ejecuta la macro en la hoja1, los resultados quedarán en la hoja2

Sub IncrementarDatos()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    '
    h2.UsedRange.Offset(1, 0).ClearContents
    h1.Columns("B:B").Copy h2.[A1]
    u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
    h2.Range("A1:A" & u2).RemoveDuplicates Columns:=1, Header:=xlYes
    '
    cols = Array("", "B", "C", "J", "O", "P", "Q", "X")
    lets = Array("", "a", "b", "c", "d", "e", "F", "g")
    m = 2
    u1 = h1.Range("B" & Rows.Count).End(xlUp).Row
    For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
        veces = WorksheetFunction.CountIf(h1.Range("B2:B" & u1), h2.Cells(i, "A"))
        f = h1.Columns("B").Find(h2.Cells(i, "A"), lookat:=xlWhole).Row
        For j = 1 To veces * 2
            For k = 1 To 7
                h2.Cells(m, "C") = h2.Cells(i, "A")
                h2.Cells(m, "E") = j
                h2.Cells(m, "F") = k
                h2.Cells(m, "G") = lets(k)
                h1.Cells(f, cols(k)).Copy h2.Cells(m, "H")
                m = m + 1
            Next
        Next
    Next
    h2.Columns("A").Clear
    Application.ScreenUpdating = True
    MsgBox "Proceso terminado", vbInformation, "INCREMENTAR DATOS"
End Sub

':)
'S aludos. D a n t e   A m o r . R ecuerda valorar la respuesta. G racias
':)

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas