Chýbajú mi informácie, odpoveď si neposlal, takže zatiaľ len takto.
Aplikuj na svoju tabuľku.
Funguje to za predpokladu, že v stĺpci N sú zalamované údaje (čo predpokladám, že sú).
Ostáva poroztínať mená a dátumy narodenia...
Sub Doplnenie()
Application.ScreenUpdating = False
prvy = 2
For i = 1 To Range("A1").End(xlDown).Row - 1
zac = prvy
pocet = Range("O" & prvy)
For j = prvy To prvy + pocet - 2
With Rows(j & ":" & j)
.Copy
.Insert Shift:=xlDown
End With
Next j
Range("P" & zac) = Range("N" & zac)
Application.CutCopyMode = False
ria = zac
PocOs = 0
dalsi:
For k = 1 To Len(Range("P" & zac))
If Mid(Range("P" & zac), k, 1) = Chr(10) Then
Vymaz (ria + 1)
Range("D" & ria + 1) = Mid(Range("P" & zac), 1, k - 1)
PocOs = PocOs + 1
Range("P" & zac) = Mid(Range("P" & zac), k + 1)
ria = ria + 1
GoTo dalsi
End If
If k = Len(Range("P" & zac)) And Range("P" & zac) <> "" Then
Vymaz (ria + 1)
Range("D" & ria + 1) = Range("P" & zac)
PocOs = PocOs + 1
Range("P" & zac) = ""
Exit For
End If
Next k
If PocOs <> (Range("O" & zac) - 1) Then
MsgBox "Počet spoluubytovaných na riadku " & zac & " nesúhlasí s počtom osôb celkom", vbCritical, "Chyba"
Exit Sub
End If
prvy = prvy + pocet
Next i
Range("A1").Select
End Sub
Sub Vymaz(rv)
Range("A" & rv & ",D" & rv & ":F" & rv & ",M" & rv & ":O" & rv).ClearContents
End Sub
Je tam ošetrený prípad nesúladu medzi počtom uvedených spolubývajúcich v stĺpci N s počtom osôb celkom, uvedených v stĺpci O.V takom prípade sa síce vytvorí plná kópia riadku rezervátora, ale ďalej sa nespracuje a postup sa zastaví.
Možno to ošetriť tak, že po zastavení sa údaje manuálne skorigujú a spustí sa makro od riadku s rezervátorom, u ktorého sa vyskytla chyba (treba dopracovať)
Mám pokračovať?
P.S. Skratky v, m a mv sú nespracovávané?