Sayfalardan sayfa3 e veri aktarma

[halilbay2]

Merhabalar.
Siteden bulduğum aşağıdaki kodlar farklı sayfalardan Sayfa3 e veri aktarıyor. Çok güzel ama bir sayfa daha ekledik onuda aktarmak istiyoruz o zaman aktarılan sayfaları tekrar aktarıyor. Yani önce aktarılan sayfaları tekrar aktarmasın tabiki mümkünse ilgilerinize teşekkür ederim.

Sub aktar()
Dim i As Long, sat As Long, k As Long
Sheets("Sayfa3").Select
Application.ScreenUpdating = False
For i = 1 To Worksheets.Count
If Worksheets(i).Name <> "Sayfa3" Then
sat = Cells(65536, "A").End(xlUp).Row + 1
For k = 1 To Sheets(i).Cells(65536, "A").End(xlUp).Row
adr1 = Range(Cells(k, "A"), Cells(k, "F")).Address
adr2 = Range(Cells(sat, "A"), Cells(sat, "F")).Address
Range(adr2).Value = Sheets(i).Range(adr1).Value
sat = sat + 1
Next k
End If
Next i
Application.ScreenUpdating = True
MsgBox "AKTARMA TAMAMLANDI..", vbOKOnly + vbInformation
End Sub

 

[Orion1]

Bu kodlar bütün sayfaları 1er kez sayfa3'e aktarır.Bir sayfayı da 2nci defa aktarmaz.

 

[halilbay2]

Ekteki dosyadan daq anlaşılacağı üzere yeni sayfa ekleyp; safa3 teki verileri silmeden aktar tuşuna basılırsa tüm sayfalar tekrar aktarılıyor.
İlginiz için teşekkür eder yardımlarınızı bekliyorum.

 

[halilbay2]

her butona tıklayışta sayfa3 ü temizletip tekrar dağıttırırsak olacak herhalde
Yardımlarınızı beliyorum saygılarımla.

 

[Orion1]

Aşağıdaki kodları deneyiniz.

Sub aktar()
Dim i As Long, sat As Long, k As Long
Sheets("Sayfa3").Select
Application.ScreenUpdating = False
[B][COLOR="Red"]Range("A1:F65536").ClearContents[/COLOR][/B]
For i = 1 To Worksheets.Count
If Worksheets(i).Name <> "Sayfa3" Then
sat = Cells(65536, "A").End(xlUp).Row + 1
For k = 1 To Sheets(i).Cells(65536, "A").End(xlUp).Row
adr1 = Range(Cells(k, "A"), Cells(k, "F")).Address
adr2 = Range(Cells(sat, "A"), Cells(sat, "F")).Address
Range(adr2).Value = Sheets(i).Range(adr1).Value
sat = sat + 1
Next k
End If
Next i
Application.ScreenUpdating = True
MsgBox "AKTARMA TAMAMLANDI..", vbOKOnly + vbInformation
End Sub

 

[halilbay2]

Sayın Orion2 ilginize ve emeğinize sağlık inanın bana ne kadar yardım ettiğinizi bilemezsiniz. Hayatta mutluluk ve esnlikler dilerim.

 

[ünal karadavut]

Orion2
Allah Raz&#305; olsun b&#246;yle bir &#351;ey ar&#305;yordum.
derdime derman oldunuz.
bu soruyu soran halilbay2 karde&#351;imdende allah raz&#305; olsun.

 

[Orion1]

Say&#305;n Orion2 ilginize ve eme&#287;inize sa&#287;l&#305;k inan&#305;n bana ne kadar yard&#305;m etti&#287;inizi bilemezsiniz. Hayatta mutluluk ve esnlikler dilerim.

Orion2
Allah Raz&#305; olsun b&#246;yle bir &#351;ey ar&#305;yordum.
derdime derman oldunuz.
bu soruyu soran halilbay2 karde&#351;imdende allah raz&#305; olsun.

Rica ederim.
&#304;yi &#231;al&#305;&#351;malar.