Копирование при 2х условиях

[mizizipipi]

Помогите пожалуйста сделать макрос.
У меня не как не получается. Замучился уже.
Макрос простой.

Если в столбце значение встречается один раз
то нужно 2 раза скопировать строку с этим значением.

А если встречается 2 то нужно 1 раз скопировать строку с этим значением.

Столбцы небольшие и количество строк разное. Значения из цифр и букв.

К примеру есть таблица
1
2
2
2
3
3

Должно получиться
1
1
1
2
2
2
3
3
3

Спасибо.

[kuklp]

>> Макрос простой.
Раз так, то и сами управитесь.

[mizizipipi]

Сообщение от kuklp

>> Макрос простой.
Раз так, то и сами управитесь.

К сожалению пока не справился.
По этой причини и обратился за помощью.

[IgorGO]

Sub InsRows()
  Dim r As Long, n As Long
  For r = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
    n = 3 - WorksheetFunction.CountIf([a:a], Cells(r, 1))
    If n > 0 Then Rows(r).Copy: Cells(r + 1, 1).Resize(n, 1).EntireRow.Insert shift:=xlDown
  Next
End Sub

[mizizipipi]

Сообщение от IgorGO

Sub InsRows()
  Dim r As Long, n As Long
  For r = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
    n = 3 - WorksheetFunction.CountIf([a:a], Cells(r, 1))
    If n > 0 Then Rows(r).Copy: Cells(r + 1, 1).Resize(n, 1).EntireRow.Insert shift:=xlDown
  Next
End Sub

Огромное человеческое спасибо!
Очень помогли!