Şartlı Veri Aktarımı

[kurtomerfaruk]

Selamlar,

Ektede anlatmış olduğum üzere Sayfa1 de bulunan bilgileri Sayfa2 deki şablonu kullanıp her bir personelin ismi ile ayrı sayfa oluşturup şablonu oraya kaydetme işlemi nasıl yaparım.

Şimdiden yardımlarınız için teşekkürler

 

[uzmanamele]

merhaba

bu kod işinizi görür mü?

Sub SablonSayfaEkle()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
ss = s1.Range("a65536").End(3).Row
Application.ScreenUpdating = False
For i = 2 To ss
s2.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = s1.Cells(i, "b")
    Range("b1") = ""
    Range("b2") = s1.Cells(i, "b")
    Range("b3") = s1.Cells(i, "e")
    Range("b4") = s1.Cells(i, "f")
    Range("e1") = s1.Cells(i, "c")
    Range("e2") = s1.Cells(i, "d")
    Range("e3") = s1.Cells(i, "g")
Next
Application.ScreenUpdating = True
End Sub

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu boş bir modüle uygulayıp denermisiniz.

Option Explicit
 
Sub AKTAR()
    Dim S1 As Worksheet, SAYFA As Worksheet, X As Integer
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set S1 = Sheets("Sayfa1")
    
    For Each SAYFA In ThisWorkbook.Worksheets
        If SAYFA.Name <> "Sayfa1" And SAYFA.Name <> "Sayfa2" Then SAYFA.Delete
    Next
    
    For X = 2 To S1.Cells(Rows.Count, 1).End(3).Row
        If S1.Cells(X, 2) <> "" Then
            Sheets("Sayfa2").Copy After:=Sheets(Worksheets.Count)
            ActiveSheet.Name = S1.Cells(X, 2)
            Range("B1") = S1.Cells(X, 1)
            Range("B2") = S1.Cells(X, 2)
            Range("B3") = S1.Cells(X, 5)
            Range("B4") = S1.Cells(X, 6)
            Range("E1") = Format(S1.Cells(X, 3), "dd.mm.yyyy")
            Range("E2") = Format(S1.Cells(X, 4), "dd.mm.yyyy")
            Range("E3") = S1.Cells(X, 7)
        End If
    Next
 
    Set S1 = Nothing
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[kurtomerfaruk]

Arkadaşlar yardımlarınız için çok teşekkür ederim. İşime yaradı kodlar