• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Tablo yardımı

M

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
840
Excel Vers. ve Dili
Office 2016 TR
Merhaba,

Ekli dosyada günlük olarak kullandığım sabit bir tablom mevcut. Bu tablodaki verileri bir önceki sayfaya özet halinde listelemesini istiyorum. Hergün tüm hatlarda üretim olmayabiliyor listeleme yaparken boşluklar olmadan listeleme yapabilir mi?

Yardımlarınız için teşekkür ederim.
 

Ekli dosyalar

Aşağıdaki makroyu deneyin:

PHP: 
Sub aktar()
Set s1 = Sheets("GÜNDÜZ")
Set s2 = Sheets("Sayfa1")
For hat = 11 To 46
    If s1.Cells(hat, "D") <> "" Then
        yeni = s2.Cells(Rows.Count, "C").End(3).Row + 1
        yer = s1.Cells(hat + 1, "B").End(3).Row
        s2.Cells(yeni, "C") = s1.Cells(yer, "B")
        s2.Cells(yeni, "D") = s1.Cells(hat, "D")
        s2.Cells(yeni, "E") = s1.Cells(hat, "F")
        s2.Cells(yeni, "F") = s1.Cells(hat, "M")
        s2.Cells(yeni, "G") = s1.Cells(hat, "N")
        s2.Cells(yeni, "H") = s1.Cells(hat, "O")
        s2.Cells(yeni, "I") = s1.Cells(hat, "Q")
        s2.Cells(yeni, "J") = s1.Cells(hat, "R")
    End If
Next
End Sub
 
YUSUF44' Alıntı:
Aşağıdaki makroyu deneyin:

PHP: 
Sub aktar()
Set s1 = Sheets("GÜNDÜZ")
Set s2 = Sheets("Sayfa1")
For hat = 11 To 46
    If s1.Cells(hat, "D") <> "" Then
        yeni = s2.Cells(Rows.Count, "C").End(3).Row + 1
        yer = s1.Cells(hat + 1, "B").End(3).Row
        s2.Cells(yeni, "C") = s1.Cells(yer, "B")
        s2.Cells(yeni, "D") = s1.Cells(hat, "D")
        s2.Cells(yeni, "E") = s1.Cells(hat, "F")
        s2.Cells(yeni, "F") = s1.Cells(hat, "M")
        s2.Cells(yeni, "G") = s1.Cells(hat, "N")
        s2.Cells(yeni, "H") = s1.Cells(hat, "O")
        s2.Cells(yeni, "I") = s1.Cells(hat, "Q")
        s2.Cells(yeni, "J") = s1.Cells(hat, "R")
    End If
Next
End Sub
Genişletmek için tıkla ...

Teşekkür ederim hocam, denedim çalıştı ancak hat 7 aktarımını yapmadı.
 
O kısma dikkat etmemişim. Aşağıdaki gibi deneyin:

PHP: 
Sub aktar()
Set s1 = Sheets("GÜNDÜZ")
Set s2 = Sheets("Sayfa1")
For hat = 11 To 46
    If s1.Cells(hat, "D") <> "" Then
        yeni = s2.Cells(Rows.Count, "C").End(3).Row + 1
        yer = s1.Cells(hat + 1, "B").End(3).Row
        s2.Cells(yeni, "C") = s1.Cells(yer, "B")
        s2.Cells(yeni, "D") = s1.Cells(hat, "D")
        s2.Cells(yeni, "E") = s1.Cells(hat, "F")
        s2.Cells(yeni, "F") = s1.Cells(hat, "M")
        s2.Cells(yeni, "G") = s1.Cells(hat, "N")
        s2.Cells(yeni, "H") = s1.Cells(hat, "O")
        s2.Cells(yeni, "I") = s1.Cells(hat, "Q")
        s2.Cells(yeni, "J") = s1.Cells(hat, "R")
    End If
Next
For hat7 = 53 To 60
    If s1.Cells(hat7, "G") <> "" Then
        yeni = s2.Cells(Rows.Count, "C").End(3).Row + 1
        s2.Cells(yeni, "C") = s1.[B53]
        s2.Cells(yeni, "E") = s1.Cells(hat7, "G")
        s2.Cells(yeni, "J") = s1.Cells(hat7, "R")
    End If
Next
End Sub
 
YUSUF44' Alıntı:
O kısma dikkat etmemişim. Aşağıdaki gibi deneyin:

PHP: 
Sub aktar()
Set s1 = Sheets("GÜNDÜZ")
Set s2 = Sheets("Sayfa1")
For hat = 11 To 46
    If s1.Cells(hat, "D") <> "" Then
        yeni = s2.Cells(Rows.Count, "C").End(3).Row + 1
        yer = s1.Cells(hat + 1, "B").End(3).Row
        s2.Cells(yeni, "C") = s1.Cells(yer, "B")
        s2.Cells(yeni, "D") = s1.Cells(hat, "D")
        s2.Cells(yeni, "E") = s1.Cells(hat, "F")
        s2.Cells(yeni, "F") = s1.Cells(hat, "M")
        s2.Cells(yeni, "G") = s1.Cells(hat, "N")
        s2.Cells(yeni, "H") = s1.Cells(hat, "O")
        s2.Cells(yeni, "I") = s1.Cells(hat, "Q")
        s2.Cells(yeni, "J") = s1.Cells(hat, "R")
    End If
Next
For hat7 = 53 To 60
    If s1.Cells(hat7, "G") <> "" Then
        yeni = s2.Cells(Rows.Count, "C").End(3).Row + 1
        s2.Cells(yeni, "C") = s1.[B53]
        s2.Cells(yeni, "E") = s1.Cells(hat7, "G")
        s2.Cells(yeni, "J") = s1.Cells(hat7, "R")
    End If
Next
End Sub
Genişletmek için tıkla ...

Çok güzel oldu, teşekkür ederim hocam. Bir ricam daha olabilir mi ? Aktarım yaparken Sayfa 1 temizleme yapılabilir mi ?
 
Aşağıdaki gibi deneyin:

PHP: 
Sub aktar()
Set s1 = Sheets("GÜNDÜZ")
Set s2 = Sheets("Sayfa1")
For hat = 11 To 46
    If s1.Cells(hat, "D") <> "" Then
        yeni = s2.Cells(Rows.Count, "C").End(3).Row + 1
        yer = s1.Cells(hat + 1, "B").End(3).Row
        s2.Cells(yeni, "C") = s1.Cells(yer, "B")
        s2.Cells(yeni, "D") = s1.Cells(hat, "D")
        s2.Cells(yeni, "E") = s1.Cells(hat, "F")
        s2.Cells(yeni, "F") = s1.Cells(hat, "M")
        s2.Cells(yeni, "G") = s1.Cells(hat, "N")
        s2.Cells(yeni, "H") = s1.Cells(hat, "O")
        s2.Cells(yeni, "I") = s1.Cells(hat, "Q")
        s2.Cells(yeni, "J") = s1.Cells(hat, "R")
    End If
Next
For hat7 = 53 To 59
    If s1.Cells(hat7, "G") <> "" Then
        yeni = s2.Cells(Rows.Count, "C").End(3).Row + 1
        s2.Cells(yeni, "C") = s1.[B53]
        s2.Cells(yeni, "E") = s1.Cells(hat7, "G")
        s2.Cells(yeni, "J") = s1.Cells(hat7, "R")
    End If
Next
s1.[D11:R45].ClearContents
s1.[G53:R59].ClearContents
End Sub
 
YUSUF44' Alıntı:
Aşağıdaki gibi deneyin:

PHP: 
Sub aktar()
Set s1 = Sheets("GÜNDÜZ")
Set s2 = Sheets("Sayfa1")
For hat = 11 To 46
    If s1.Cells(hat, "D") <> "" Then
        yeni = s2.Cells(Rows.Count, "C").End(3).Row + 1
        yer = s1.Cells(hat + 1, "B").End(3).Row
        s2.Cells(yeni, "C") = s1.Cells(yer, "B")
        s2.Cells(yeni, "D") = s1.Cells(hat, "D")
        s2.Cells(yeni, "E") = s1.Cells(hat, "F")
        s2.Cells(yeni, "F") = s1.Cells(hat, "M")
        s2.Cells(yeni, "G") = s1.Cells(hat, "N")
        s2.Cells(yeni, "H") = s1.Cells(hat, "O")
        s2.Cells(yeni, "I") = s1.Cells(hat, "Q")
        s2.Cells(yeni, "J") = s1.Cells(hat, "R")
    End If
Next
For hat7 = 53 To 59
    If s1.Cells(hat7, "G") <> "" Then
        yeni = s2.Cells(Rows.Count, "C").End(3).Row + 1
        s2.Cells(yeni, "C") = s1.[B53]
        s2.Cells(yeni, "E") = s1.Cells(hat7, "G")
        s2.Cells(yeni, "J") = s1.Cells(hat7, "R")
    End If
Next
s1.[D11:R45].ClearContents
s1.[G53:R59].ClearContents
End Sub
Genişletmek için tıkla ...

Teşekkür ederim, emeğinize sağlık
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst