Boş satırları atlayıp devam etsin

[Mx@Raid]

Arkadaşlar elimdeki listenin arasında boş olan bazı hücre satırları var bunları atlayarak dolu hücreden tekrar devam etmesini istiyorum. yazdığım makro istediğimi vermedi bu konuda yardımcı olursanız sevinirim.

Sub Degistir()
    For i = 4 To Cells(65536, "H").End(xlUp).Row
        If Cells(i, "H").Value = Empty Then i = IIf([H4] = "", 1, [H65536].End(3).Row + 1)

            Cells(i, 2) = Cells(i, 2) & Chr(32) & Cells(i, 3)
            Cells(i, 3) = Cells(i, 4)
            Cells(i, 4) = Cells(i, 5)
            Cells(i, 5) = Cells(i, 6) & Chr(45) & Cells(i, 7) & Chr(45) & Cells(i, 8)
    Next
        'Columns("F:H").Delete Shift:=xlToLeft
End Sub

yazdığım kod bu şekilde

 

[Mx@Raid]

Sorun hakkında uzman arkadaşlarımızdan biri ilgilenemez mi acaba?

 

[Mx@Raid]

Arkadaşlar konuya bi el atabilir misiniz?

 

[Necdet]

Merhaba,

Sorunuz pek anlaşılır gibi değil ki, makrom çalışmıyor diyorsunuz, demekki yazdığınız makroyu bilgisayar anlamamış, peki biz nasıl anlayalım?

Kodları değil ne yapmak istediğinizi açıklarsanız yardımcı olacak arkadaşları bulabilirsiniz.

 

[Orion1]

Merhaba,

Sorunuz pek anlaşılır gibi değil ki, makrom çalışmıyor diyorsunuz, demekki yazdığınız makroyu bilgisayar anlamamış, peki biz nasıl anlayalım?

..............................................

 

[Mx@Raid]

Arkadaşlar makro çalışmıyor değil. Çalışıyor lakin h sütununda dolu sütün bitip boş sütün başladığında makro devam etmiyor. Benim amacım aradaki boş sütunları atlayıp makronun devam etmesi. Makroyu ...Then i= i+1 veya buna yakın bir uygulama yaptığımda ise h sütundaki boş hücrelere de işlem yapıyor.

 

[Mx@Raid]

Arkadaşlar bu şekilde de olmuyor bu ilgilenemez misiniz

Sub Degistir()
bsay = WorksheetFunction.CountA(Range("H4:H65536"))
For i = 4 To Cells(65536, "H").End(xlUp).Row
If Cells(i, "H").Value = Empty Then i = bsay + i

Cells(i, 2) = Cells(i, 2) & Chr(32) & Cells(i, 3)
Cells(i, 3) = Cells(i, 4)
Cells(i, 4) = CDate(Cells(i, 5))
Cells(i, 5) = Cells(i, 6) & Chr(45) & Cells(i, 7) & Chr(45) & Cells(i, 8)
Next
'Columns("F:H").Delete Shift:=xlToLeft
End Sub

 

[Mx@Raid]

Arkadaşlar dosyada ne yapmak istediğimi anlatmaya çalıştım. Yardımcı olursanız sevinirim.

 

[Mx@Raid]

Arkadaşlar çözüm üretecek arkadaşlar yok mu? çok deneme yaptım ancak bir türlü sonuca ulaşamıyorum.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Sub DEĞİŞTİR()
    Dim X As Long
    
    For X = 4 To Cells(65536, 8).End(xlUp).Row
        If IsEmpty(Cells(X, 8)) = False Then
            Cells(X, 2) = Cells(X, 2) & Chr(32) & Cells(X, 3)
            Cells(X, 3) = Cells(X, 4)
            Cells(X, 4) = Cells(X, 5)
            Cells(X, 5) = Cells(X, 6) & Chr(45) & Cells(X, 7) & Chr(45) & Cells(X, 8)
        End If
    Next
    
    'Columns("F:H").Delete Shift:=xlToLeft
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Mx@Raid]

Korhan Bey çok teşekkür ederim. Emeğinize ve aklınıza sağlık.