satır kaydırma

[mrt]

Selamlar,

ara boşlukları olan veri tablosunda;

E5:H5 aralığındaki veriler ; J4:N4 aralığına yazılacak.
Sonra G6 hücresi sıfırdan büyük ise E6:H6 aralığındaki veriler sağa kaydırılacak.(veriler J6:N6 aralığına yzılmış olacak.)
B4:H4 aralığındaki veriler B6:H6 aralığına yazılacak.


E8:H8 aralığındaki veriler ; J7:N7 aralığına yazılacak.
Sonra G9 hücresi sıfırdan büyük ise E9:H9 aralığındaki veriler sağa kaydırılacak.
B7:H7 aralığındaki veriler B9:H9 aralığına yazılacak.

bu kontrol G sütununun son verisine kadar devam edecek.

Bu döngüyü nasıl yaparım.

Ekli dosyada veriler ve manuel düzenleme mevcut.

 

[sandokan]

bu konuda bende muzdaribim
aynı sayfada yazdırma alanı sece sece bir hal oldum..yokmu bunun çözümü..
yazdır diyince ayrı sayfalard halinda yazdırmasını saglayan bişey

 

[Korhan Ayhan]

Selamlar,

Sn. mrt aşağıdaki linkte buna benzer bir soru sormuştunuz. Linkte en son verdiğim kodlar işinize yaramadı mı?

http://www.excel.web.tr/showthread.php?t=23271

 

[Korhan Ayhan]

Selamlar,

Eğer verdiğim linkte kod işinize yaramadıysa aşağıdaki kodu verilerinizin bir yedeğini alarak denermisiniz.

Sub VERİLERİ_DÜZENLE()
    Set S1 = Sheets("veri")
    S1.[J1:N1].Value = S1.[E2:I2].Value
    S1.[B1:N1].Font.Bold = True
    SATIR = 2
    For X = 2 To S1.[G65536].End(3).Row
    If S1.Cells(X, "B") <> "" Then
    S1.Range(Cells(SATIR, "B"), Cells(SATIR, "I")).Value = S1.Range(Cells(X, "B"), Cells(X, "I")).Value
    S1.Cells(SATIR, "J") = S1.Cells(X + 1, "E")
    S1.Cells(SATIR, "K") = S1.Cells(X + 1, "F")
    S1.Cells(SATIR, "L") = S1.Cells(X + 1, "G")
    S1.Cells(SATIR, "M") = S1.Cells(X + 1, "H")
    S1.Cells(SATIR, "N") = S1.Cells(X + 1, "I")
    SATIR = SATIR + 1
    If S1.Cells(X + 2, "E") <> "" Then
    S1.Range(Cells(SATIR, "B"), Cells(SATIR, "I")).Value = S1.Range(Cells(X, "B"), Cells(X, "I")).Value
    S1.Cells(SATIR, "J") = S1.Cells(X + 2, "E")
    S1.Cells(SATIR, "K") = S1.Cells(X + 2, "F")
    S1.Cells(SATIR, "L") = S1.Cells(X + 2, "G")
    S1.Cells(SATIR, "M") = S1.Cells(X + 2, "H")
    S1.Cells(SATIR, "N") = S1.Cells(X + 2, "I")
    SATIR = SATIR + 1
    End If
    End If
    Next
    SON = S1.[B1].End(4).Row + 1
    S1.Range(Cells(SON, "B"), Cells(65536, "I")) = ""
    S1.Cells.EntireColumn.AutoFit
    MsgBox "Veri düzenleme işlemi tamamlanmıştır.", vbInformation
End Sub