Eğer ... Hücre doluysa satır eklesin

[vol1237]

Arkadaşlar kolay gelsin.


elimde bu şekilde bir excel tablom var yaklaşık 5 bin tane satır olan. Mesela ekli örnekte 1.satırda A ve B hücresinden sonra gelen C1 E1 F1 G1 H1
dolu olduğu için dolu olan beş hücre için 5 satır eklemesini istiyorum.
Böyle bir makro yazılması mümkün müdür acaba? yardımlarınızı bekliyorum

http://s3.dosya.tc/server31/aomAou/_rnek.xlsx.html

 

[Emir Hüseyin Çoban]

. . .

E sütununu dikkate almayacak mı?

Örneğinizde 1.satırda E sütunuda dolu.

. . .

 

[vol1237]

. . .

E sütununu dikkate almayacak mı?

Örneğinizde 1.satırda E sütunuda dolu.

. . .

ilgili satıra denk geken bütün hepsini dikkate alacak yazarken eksik yazmış olabailirim. o şekilde dolu olan 15 hücre varsa 15 satır eklemesi lazım Teşekkürler

 

[vol1237]

Bu arada yan yana a ve b hariç olmak üzere en fazla15- 16 hücre var az önce kontrol ettim. yani en fazla Q sütunun kadar dolu elimdeki veriler

 

[Emir Hüseyin Çoban]

. . .

Sub KOD()
    Application.ScreenUpdating = False
    For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
        say = WorksheetFunction.CountIf(Range("C" & i & ":Z" & i), "<>")
        If say > 0 Then
            Rows(i + 1 & ":" & i + say).Insert Shift:=xlDown
        End If
    Next i
    Application.ScreenUpdating = True
    MsgBox "B i t t i "
End Sub

. . .

 

[vol1237]

. . .

Sub KOD()
    Application.ScreenUpdating = False
    For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
        say = WorksheetFunction.CountIf(Range("C" & i & ":Z" & i), "<>")
        If say > 0 Then
            Rows(i + 1 & ":" & i + say).Insert Shift:=xlDown
        End If
    Next i
    Application.ScreenUpdating = True
    MsgBox "B i t t i "
End Sub

. . .

ellerine sağlık hocam sağolasın. bunu yaklaşık 5 bin satırlık bi veriye uygulayabilirim değil mi?

 

[Emir Hüseyin Çoban]

. . .

Tablonuzdan bir yedek alın daha sonra kodları çalıştırarak sonucu gözlemleyin.

. . .

 

[vol1237]

Tmm hocam deneyip dönüş de yaparim ellerinize saglik

 

[vol1237]

Teşekkür ederim sorunsuz çalışıyor Saygılar..