Tablo yardımı

M

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
834
Excel Vers. ve Dili
Office 2016 TR
Altın Üyelik Bitiş Tarihi
08-09-2028
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

YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
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
 
M

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
834
Excel Vers. ve Dili
Office 2016 TR
Altın Üyelik Bitiş Tarihi
08-09-2028
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ı.
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
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
 
M

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
834
Excel Vers. ve Dili
Office 2016 TR
Altın Üyelik Bitiş Tarihi
08-09-2028
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 ?
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
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
 
M

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
834
Excel Vers. ve Dili
Office 2016 TR
Altın Üyelik Bitiş Tarihi
08-09-2028
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.
Üst