kod değişikliği

[meda58]

Option Explicit
Sub üstü_alta_kopyala_1967()
'Konu : Üstteki Dolu Satırı Boş Satıra Kopyalama
'Mail : m.batu.1967@gmail.com
'Coder By : asi_kral_1967
Dim asi As Long
For asi = 4 To Cells(Rows.Count, "A").End(xlUp).Row
If Cells(asi, "B") <> "Member:" And Cells(asi, "B") <> "Distribution:" Then
If Cells(asi, "B") = "Period:" Then asi = asi + 2
If Cells(asi, "B") = Empty Then
Cells(asi, "B") = Cells(asi - 1, "B")
End If
End If
Next
MsgBox "İşlem Tamamlandı", vbInformation, "asi_kral_1967"
End Sub




yukarıdaki kod çok güzel çalışıyor yalnız B sütünunu B C D E olarak nasıl değiştirebilirim

YanıtlaYönlendir

 

[bmutlu966]

Deneyiniz.

Sub üstü_alta_kopyala_1967()
'Konu : Üstteki Dolu Satırı Boş Satıra Kopyalama
'Mail : m.batu.1967@gmail.com
'Coder By : asi_kral_1967
Dim asi As Long

For c = 2 To 5

For asi = 4 To Cells(Rows.Count, "A").End(xlUp).Row
If Cells(asi, c) <> "Member:" And Cells(asi, c) <> "Distribution:" Then
If Cells(asi, c) = "Period:" Then asi = asi + 2
If Cells(asi, c) = Empty Then
Cells(asi, c) = Cells(asi - 1, c)
End If
End If
Next

Next
MsgBox "İşlem Tamamlandı", vbInformation, "asi_kral_1967"
End Sub

 

[meda58]

Deneyiniz.

Sub üstü_alta_kopyala_1967()
'Konu : Üstteki Dolu Satırı Boş Satıra Kopyalama
'Mail : m.batu.1967@gmail.com
'Coder By : asi_kral_1967
Dim asi As Long

For c = 2 To 5

For asi = 4 To Cells(Rows.Count, "A").End(xlUp).Row
If Cells(asi, c) <> "Member:" And Cells(asi, c) <> "Distribution:" Then
If Cells(asi, c) = "Period:" Then asi = asi + 2
If Cells(asi, c) = Empty Then
Cells(asi, c) = Cells(asi - 1, c)
End If
End If
Next

Next
MsgBox "İşlem Tamamlandı", vbInformation, "asi_kral_1967"
End Sub

ALLAH RAZI OLSUN ÇOK GÜZEL OLDU 2 GÜN UĞRAŞTIM ÇÖZEMEDİM