sayfayı kopyalama

[asubsubaru]

kolay gelsin bir ustalar

sayfa3 teki tuşa basarak, sayfa1 deki bütün veriyi, yeni bir sayfa açarak oraya otomatik olarak kopyalamak istiyorum yadrımlarınızı bekliyorum

 

[hamitcan]

Forumda bolca örnek mevcut, arama yapın.
http://www.excel.web.tr/f14/sim-sayfa-acma-veri-aktarma-t58755/sayfa2.html

 

[asubsubaru]

ilginiz için teşekkürler ama gönderdiğiniz linktekilere baktım fakat istediğim gibi birşeye rastlayamadım

benim tam olarak istediğim 2. sayfadaki tuşa astığımda 1. sayfanın tamamını kopyalıyacak yeni bir sayfa açacak adını sonuç olarak değiştirdikten sonra kopyalamış olduu veriyi buraya yapıştıracak

 

[hamitcan]

Küçük bir dosya ekleyin, konunun uzamaması için.

 

[asubsubaru]

dosya ekliyorum

 

[usubaykan]

Merhaba;

Örnek bir kod ekliyorum umarım faydalanabilirsiniz.

Option Explicit
Sub Makro1()
Dim onay
Application.DisplayAlerts = False
    On Error GoTo hata
    Sheets("rapor").Cells.Copy
    Sheets.Add
    ActiveSheet.Name = "SONUÇ"
    ActiveSheet.Paste
    Range("A1").Select
    Exit Sub
hata:
onay = MsgBox("Aynı isimli sayfa mevcuttur sayfasını ismi Orjinal ismi olacaktır.", vbCritical + vbYesNo)
If onay = vbNo Then
ActiveSheet.Delete
Else
Sheets.Add
Application.DisplayAlerts = True
End If
End Sub

 

[hamitcan]

Sub SonucSayfasiEkle()
    On Error Resume Next
    Set sh = Sheets("sonuc")
    If sh Is Nothing Then
    Sheets("rapor").Copy _
           after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "sonuc"
    End If
End Sub

 

[asubsubaru]

teşekkürler bi sorum daha olacak

en başa bu olacak

Private Sub CommandButton1_Click()

altında bu

Sub SonucSayfasiEkle()
On Error Resume Next
Set sh = Sheets("sonuc")
If sh Is Nothing Then
Sheets("rapor").Copy _
after:=Sheets(Sheets.Count)
ActiveSheet.Name = "sonuc"
End If
End Sub

buun altında aşağıdaki

Set s1 = Sheets("sonuç")
Set s2 = Sheets("ekle")
For a = 1 To s2.[b65536].End(3).Row
If s2.Cells(a, "a") <> "" Then
c = c + 1
sonn = 0
deger = s2.Cells(a, "a")
ilk = WorksheetFunction.Match(deger, s1.[a:a], 0)
sonn = WorksheetFunction.CountIf(s1.[a:a], deger) + ilk
End If
s1.Rows(sonn).Insert Shift:=xlDown
s1.Cells(sonn, "d").NumberFormat = s2.Cells(a, "d").NumberFormat
s1.Cells(sonn, "d") = s2.Cells(a, "d")
s1.Cells(sonn, "e").NumberFormat = s2.Cells(a, "e").NumberFormat
s1.Cells(sonn, "e") = s2.Cells(a, "e")
If c = 1 Then
s1.Cells(sonn, "a") = deger
c = 0
End If
sonn = sonn + 1
Next
End Sub


bir tuşa bastığımda sırayla ikiside çalışacak bunu nasıl ayarlayabilirim