Sayfa bağlantısı aktarma

[tatamama]

Sayfalara aktarma yapmak istiyorum yardımcı olursanız sevinirim.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Not: Sayfa isimlerinizin sonunda boşluklar bırakmışsınız onları kaldırırsanız kod sorunsuz çalışacaktır.

Sub KAYIT()
    Set S1 = Sheets("kayıt giriş")
    Set S2 = Sheets("İŞLETME DEFTERİ")
 
    If WorksheetFunction.CountIf([C5:C65536], ">0") = 0 Then
    MsgBox "Kayıt edilecek veri bulunamamıştır.", vbExclamation, "Dikkat !"
    Exit Sub: End If
 
    SATIR = S2.[B65536].End(3).Row + 1
 
    S1.Range("C5:M" & S1.[C65536].End(3).Row).Copy S2.Range("B" & SATIR)
    If S1.[B5] <> "" Then
    Set S3 = Sheets(S1.[B5].Text)
    SATIR = S3.[A65536].End(3).Row + 1
    S1.Range("C5:M" & S1.[C65536].End(3).Row).Copy S3.Range("A" & SATIR)
    End If
 
    Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
 
    MsgBox "Kay&#305;t i&#351;lemi tamamlanm&#305;&#351;t&#305;r.", vbInformation
End Sub

 

[oguzcan26]

isterdiğinizi

 

[tatamama]

Selamlar,

Aşağıdaki kodu denermisiniz.

Not: Sayfa isimlerinizin sonunda boşluklar bırakmışsınız onları kaldırırsanız kod sorunsuz çalışacaktır.

Sub KAYIT()
    Set S1 = Sheets("kayıt giriş")
    Set S2 = Sheets("İŞLETME DEFTERİ")
 
    If WorksheetFunction.CountIf([C5:C65536], ">0") = 0 Then
    MsgBox "Kayıt edilecek veri bulunamamıştır.", vbExclamation, "Dikkat !"
    Exit Sub: End If
 
    SATIR = S2.[B65536].End(3).Row + 1
 
    S1.Range("C5:M" & S1.[C65536].End(3).Row).Copy S2.Range("B" & SATIR)
    If S1.[B5] <> "" Then
    Set S3 = Sheets(S1.[B5].Text)
    SATIR = S3.[A65536].End(3).Row + 1
    S1.Range("C5:M" & S1.[C65536].End(3).Row).Copy S3.Range("A" & SATIR)
    End If
 
    Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
 
    MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation
End Sub

yapamadım ama nerde yanlış yapıyorum

 

[Korhan Ayhan]

Selamlar,

Yapamadığınız yer neresidir?