Hücre Değerine Göre Satır ekleme

[aydinsert]

Merhaba değerli arkadaşlar, forumda aradım ama bulamadım.
İstediğim: B sütunundaki değer kadar araya satır ekleme makrosu.
Örnek dosya ektedir. Kısaca dosyayı açıklarsam: Aydın ilinden 5 adet var, araya 5 satır ekleyecek ve eklediği satırlara da bir üsttekini yazacak. Sonra Bolu' ya geçecek 10 satır ekleyecek.
Yardımcı olabileceklere şimdiden teşekkürler.

 
  

 

[GursoyC]

Dim son As Long
    Dim ekle As Integer
    son = Range("A" & Rows.Count).End(3).Row
    On Error Resume Next
        For i = son To 2 Step -1
            If Range("B" & i) > 0 Then
                ekle = Range("B" & i)
                    Rows(i + 1 & ":" & i + ekle).Insert Shift:=xlDown
            End If
        Next i

 

[aydinsert]

Dim son As Long
    Dim ekle As Integer
    son = Range("A" & Rows.Count).End(3).Row
    On Error Resume Next
        For i = son To 2 Step -1
            If Range("B" & i) > 0 Then
                ekle = Range("B" & i)
                    Rows(i + 1 & ":" & i + ekle).Insert Shift:=xlDown
            End If
        Next i

elinize sağlık, hücre değeri kadar satır ekliyor. Fakat eklediği satırlara bir üstteki satır yazdırması da lazım. Kodu bu şekilde güncelleyebilir miyiz? Teşekkürler.

 

[GursoyC]

Bir üstteki yazacak derken örnekten hareketle A3:A7 aralığına Aydın, A9:A18 aralığına da Bolu mu yazmalı?

 

[aydinsert]

Bir üstteki yazacak derken örnekten hareketle A3:A7 aralığına Aydın, A9:A18 aralığına da Bolu mu yazmalı?

Aynen öyle hem Aydın yazacak hem de karşısındaki değeri. Kısaca bir üstteki satırın tamamını yazacak.