Yeni tablo oluşturma

[Hacı Bayram ÖZKAN]

Merhaba arkadaşlar; isteğimi ekli dosyamda anlattım. Yardımcı olursanız sevinirim teşekkürler.
http://s6.dosya.tc/server7/iwnv11/PERSONEL_LISTESI.xls.html

 

[YUSUF44]

Formülle nasıl olur bilmiyorum. Makroyla isterseniz aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

Sub pasif()
Set s1 = Sheets("LİSTE")
Set s2 = Sheets("TABLO")

son = s1.Cells(Rows.Count, "F").End(3).Row

For i = 2 To son
    If s1.Cells(i, "F") = "PASİF" Then
        yeni = s2.Cells(Rows.Count, "F").End(3).Row + 1
        s1.Range("B" & i & ":G" & i).Copy: s2.Cells(yeni, "G").PasteSpecial Paste:=xlValues
        s2.Cells(yeni, "F") = yeni - 4
    End If
Next
End Sub

 

[Hacı Bayram ÖZKAN]

Yusuf bey eline sağlık olmuş hatta çok güzel olmuş ama makroyu her çalıştırdığımda tabloyu silip yeniden yapsın bu üzerine ekliyor tamam

 

[YUSUF44]

Aşağıdaki gibi deneyin:

Sub pasif()
Set s1 = Sheets("LİSTE")
Set s2 = Sheets("TABLO")

son = s1.Cells(Rows.Count, "F").End(3).Row
uyarı = MsgBox("Eski veriler silinsin mi?", vbYesNo, "Pasif Personel")
son2 = s1.Cells(Rows.Count, "F").End(3).Row
If uyarı = vbYes Then s2.Range("F5:L" & son2).ClearContents

For i = 2 To son
    If s1.Cells(i, "F") = "PASİF" Then
        yeni = s2.Cells(Rows.Count, "F").End(3).Row + 1
        s1.Range("B" & i & ":G" & i).Copy: s2.Cells(yeni, "G").PasteSpecial Paste:=xlValues
        s2.Cells(yeni, "F") = yeni - 4
    End If
Next
End Sub

 

[Hacı Bayram ÖZKAN]

Abi yoğundum geç gördüm demeyeceğim eline sağlık dua ile kal