DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
b sütünunda alt satır boş ise üst satırı kopyalasın istiyorum. ekteki dosyada sayfa1 deki veriler sayfa2 deki gibi olsun istiyorum. teşekkürler
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
b sütünunda alt satır boş ise üst satırı kopyalasın istiyorum. ekteki dosyada sayfa1 deki veriler sayfa2 deki gibi olsun istiyorum. teşekkürler
Sub kopyala()
For i = 2 To Range("A65536").End(3).Row
If Cells(i, 2).Value = "" And Cells(i - 1, 2).Value <> "Period:" And Cells(i - 1, 2).Value <> "" Then
Cells(i, 2).Value = Cells(i - 1, 2).Value
End If
Next
End Sub
çok teşekkür ederim hocam ellerine sağlık..
ekteki kodları denermisiniz.
Alternatif
Kod:Sub kopyala() For i = 2 To Range("A65536").End(3).Row If Cells(i, 2).Value = "" And Cells(i - 1, 2).Value <> "Period:" And Cells(i - 1, 2).Value <> "" Then Cells(i, 2).Value = Cells(i - 1, 2).Value End If Next End Sub
Merhaba,
Sizin tam olarak istediğiniz nedir. Detaylı açıklarmısınız.
.
Kopyala kodlarını aşağıdakilerle değiştirin.
Kod:Sub kopyala() For i = 3 To Range("A65536").End(3).Row Step 2 Cells(i, "A").Resize(1, 7).Copy Cells(i + 1, "A") Next End Sub
.