veri aktarımı

[m.gur]

İyi günler;
Dosyamda 2 adet giriş ve 2 adet bilgilerin toplandığı sayfa var. Giriş sayfası data sayfasına, arz sayfası da işlem sayfasına aktarılacak. Makro ile yapmaya çalıştım ama yapamadım. Yardımcı olurmusunuz. Teşekkürler.

 

[Orion1]

Dosyanız ektedir.

Sub aktar_59()
Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet, s4 As Worksheet
Dim sat1 As Long, sat2 As Long, sat3 As Long, sat4 As Long
Set s1 = Sheets("GİRİŞ")
Set s2 = Sheets("DATA")
Set s3 = Sheets("ARZ")
Set s4 = Sheets("İŞLEM")
sat1 = s1.Cells(65536, "AE").End(xlUp).Row
sat2 = s2.Cells(65536, "A").End(xlUp).Row + 1
sat3 = s3.Cells(65536, "A").End(xlUp).Row
sat4 = s4.Cells(65536, "A").End(xlUp).Row + 1
Application.ScreenUpdating = False
If sat2 + 37 >= 65533 Then
    MsgBox "Giriş sayfasındaki veriler,Data sayfasına sığmayacak kadar büyük!" & vbLf & _
    "Aktarma iptal edildi!!", vbCritical, "UYARI"
    ElseIf sat1 > 3 Then
    s1.Range("AE4:AL40").Copy
    s2.Range("A" & sat2).PasteSpecial xlPasteValuesAndNumberFormats
End If
If sat3 + sat4 >= 65533 Then
    MsgBox "ARZ sayfasındaki veriler İŞLEM sayfasına sığmayacak kadar büyük!" & vbLf & _
    "Aktarma İptal Edildi!", vbCritical, "UYARI"
    ElseIf sat3 > 1 Then
    s3.Range("A2:H" & sat3).Copy
    s4.Range("A" & sat4).PasteSpecial xlPasteValuesAndNumberFormats
End If
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Veriler Aktarıldı" & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"

End Sub

 

[m.gur]

Sayın Evren, çok teşekkür ederim. Sorun yok.

 

[Orion1]

Sayın Evren, çok teşekkür ederim. Sorun yok.

Rica ederim.
İyi çalışmalar.

 

[mustafakoker]

Sub Dikdörtgen_Tıklat()

Set s1 = Sheets("KASA")
son = s1.[A65536].End(3).Row + 1
If WorksheetFunction.CountA(Range("A2929")) = 0 Then
MsgBox "Lütfen Veri Giriniz", , "Teşekküler"
Else
Range("A2929").Copy s1.Range("A" & son)
Range("A2929").ClearContents
MsgBox "Aktarım Tamamlanmıştır.", , "Teşkkürler"
End If
End Sub

yukardaki şekilde sadece a29 u aktarıyor

a29:d29
a74:d74 satırlarını aktarmam için yukardaki kodu nasıl düzenlerim

teşekkürler

 

[mustafakoker]

yukardaki şekilde sadece a29 u aktarıyor

a29:d29
a74:d74 satır aralıklarını aktarmam için yukardaki kodu nasıl düzenlerim

teşekkürler

 

[mustafakoker]

ub Dikdörtgen_Tıklat()
Set s1 = Sheets("KASA")
son = s1.[A65536].End(3).Row + 1
If WorksheetFunction.CountA(Range("A2974")) = 0 Then
MsgBox "Lütfen Veri Giriniz", , "TEŞEKKÜRLER"
Else
Range("A2974").Copy s1.Range("A" & son)
Range("A2974").ClearContents
MsgBox "Aktarım Tamamlanmıştır.", , "TEŞEKKÜRLER"
End If
End Sub


sorunumu kendim çözdüm