(11/11/2019, 23:33)berduş yazdı: Amacininiz butona her bastiginizda verilerinizi ayni Excel dosyasinda yeni bir Excel sayfasina mi kaydhocam tam olarak istediğim 

hocam o şekilde işimi görüyor, dosyaismi olarak date kullanılırsa her gün için aynı excelde yenir bir sayfa açıp oraya kaydedecek.

ancak şablonu bozmadan yapıştırma yapması gerekiyor, bu örnekte tek bir sorguyu aktarıyor, ben 3 tane sorgu aktaracağım , x değişkenine ilave olarak y ve z tanımlayıp kodu kopyala yapıştır yapıp düşey ve yatay sırayı değiştirip yaptım onu. 3 tablo tek excele geliyor.. 

.rangeli satırları da sildim   dim r as range yapıp   set r=cells(5,27)  r.delete kullanarak sadece belirli alanı sildim çünkü 3 tane sorgu var diğer sorguların şablonu bozuluyor ama buda bir çalışıyor bir çalışmıyor.

şuan eksiklerim şablonu açınca üzerine değil aynımexcel dosyayısında şablonlu şekilde yeni sayfaya yazsın istiyorum.  sitede arama yapacak arkadaşlar içinde örnek uygulamayı yükleyip paylaşmak isityorum faydalı olacaktır.


KODUN DENEMEDEKİ SON HALİ

Private Sub AKTAR_Click()
' REFERANSLARDAN M?CROSOFT Excel ... OBJECT L?BRARY TANIMLAMINIZ GEREK?YOR..
Dim Exapp As Excel.Application
Dim rs As Recordset
Dim yol As String
Dim x As Long
Dim r As Range
On Error Resume Next
Set Exapp = GetObject("", "excel.application")
If Err.Number <> 0 Then
  Err.Clear
        Set Exapp = CreateObject("Excel.Application")
End If
    On Error GoTo Error_Handler
   
'exel yol tan?ml?yoruz..
yol = CurrentProject.Path & "\yeni.xlsx"
'exceli a?arak y?kler.. false derseniz.. exceli a?madan y?kler.. size kalm??
Exapp.Visible = True
Exapp.Workbooks.Open yol
'eski Excel verileri siliyoruz...
''With Exapp
         '' .Range("a5", .Range("a5").End(xlDown).End(xlDown).End(xlToRight)).Select   bunlar iptal artık çünkü alan belirtemedeim onun yerine aşağıdaki kodu kullnadım
         '' .Range("a5", .Range("a5").End(xlDown).End(xlDown).End(xlToRight)).Delete
       ''   .Range("a5").Select
''End With


With Exapp
Set r = Cells(5, 27)
r.Delete
End With



'rapor sorgusunu a??l?yor...
Set rs = CurrentDb.OpenRecordset("sorgu2")
x = 5
Do While Not rs.EOF
With Exapp
    .Cells(x, 1) = rs("il")          ' 1 A KOLONU
    .Cells(x, 2) = rs("?L?E")            '2 B KOLONUDUR
    .Cells(x, 3) = rs("G?REV BA?LAMA")
  
End With
rs.MoveNext
x = x + 1
Loop
Set rs = CurrentDb.OpenRecordset("sorgu1")
y = 5
Do While Not rs.EOF
With Exapp
    .Cells(y, 7) = rs("il")          ' 1 A KOLONU
    .Cells(y, 8) = rs("?L?E")            '2 B KOLONUDUR
    .Cells(y, 9) = rs("G?REV BA?LAMA")
  
End With
rs.MoveNext
y = y + 1
Loop

Set rs = CurrentDb.OpenRecordset("sorgu1")
z = 30
Do While Not rs.EOF
With Exapp
    .Cells(z, 5) = rs("il")          ' 1 A KOLONU
    .Cells(z, 6) = rs("?L?E")            '2 B KOLONUDUR
    .Cells(z, 7) = rs("G?REV BA?LAMA")
  
End With
rs.MoveNext
z = z + 1
Loop

'SORGUYU KAPATIYORUZ..
rs.Close
'??LEM? B?T?R?YORUZ.. VE ?IKIYORUZ..
Exit Sub
Error_Handler:
Exapp.ActiveWorkbook.Close True
Exapp.Workbooks.Close
Exapp.Quit
Set Exapp = Nothing
Resume 0
End Sub