Do
' Сделано для корректного переноса Примечаний, включающих символ ";"
If Worksheets("Лист1").Cells(I, k).Value Like "??.??.*" Then
Range("I" + CStr(I)) = Worksheets("Лист1").Cells(I, k).Value
Else
If Not (Worksheets("Лист1").Cells(I, k).Value = "") Then
Range("H" + CStr(I)) = Range("H" + CStr(I)) + ";" + Worksheets("Лист1").Cells(I, k).Value
End If
'Range("I" + CStr(I)) = Worksheets("Лист1").Cells(k + 1, I).Value
End If


Worksheets("Лист1").Cells(I, k).Value = Empty

k = k +  1 

Loop Until Worksheets("Лист1").Cells(I, k).Value = ""