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
':)