Makro İle Sayfayı Yeni Sekmede Kopyalama Hatası

[redant]

Merhabalar,

Aşağıdaki gibi kodum var. Mantık şöyle işliyor. "SABLON" adlı sayfam var ve bu sayfa fix sabit kalacak. Bu sayfada yer alan KAYDET butonuna bastıktan sonra FirmaAdı_Tarih şeklinde yeni sayfa olarak kopyalayıp, "SABLON" adlı sayfayı korumak. Kodlar istediğim her şeyi yapıyor ama şurada sorun var;

Kopyalanmış hiçbir sayfa yokken kodu çalıştırdığımda ilk sayfayı istediğim gibi kayıt ediyor. Sonra SABLON adlı sayfadan yeni bir girdi yaptıktan sonra kodu çalıştırdığımda sayfa kayıt ismi direkt SABLON (2) olarak geçiyor. Her yeni kayıtta FirmaAdı_Tarih olarak kayıt etmek istiyorum. Not: Aynı firmaya gün içerisinde birden çok girdi yapabilirim. Destekleriniz için şimdiden teşekkürler.

Sub TK()
Dim wsSablon As Worksheet
Dim wsKPI As Worksheet
Dim icmalTablo As ListObject
Dim yeniSatir As ListRow
Dim yeniSayfa As Worksheet
Dim yeniSayfaAdı As String
Dim müşteriAdı As String
Dim tarih As String
Dim urunlerTablo As ListObject
Dim i As Long
Dim mevcutSayfa As Worksheet
Dim teklifNo As String
Dim yeniTeklifNo As String
Dim sayfaMevcut As Boolean

' Sayfaları tanımla
Set wsSablon = ThisWorkbook.Sheets("SABLON")
Set wsKPI = ThisWorkbook.Sheets("KPI")

' Müşteri adı ve tarihi al
müşteriAdı = wsSablon.Range("J4").Value
tarih = wsSablon.Range("J5").Value

' Müşteri adı ve tarih zorunlu, boşsa uyarı ver
If müşteriAdı = "" Or tarih = "" Then
MsgBox "Müşteri adı ve tarih zorunludur!", vbExclamation, "Hata"
Exit Sub
End If

' Teklif numarasını al ve artır
teklifNo = ThisWorkbook.Sheets("Database").Range("A2").Value
yeniTeklifNo = "MD-" & Format(CInt(Mid(teklifNo, 4)) + 1, "0000")

' Teklif numarasını güncelle
ThisWorkbook.Sheets("Database").Range("A2").Value = yeniTeklifNo

' "icmal" tablosunu al
On Error Resume Next
Set icmalTablo = wsKPI.ListObjects("icmal")
On Error GoTo 0

' Eğer icmal tablosu yoksa çık
If icmalTablo Is Nothing Then
MsgBox "İcmal tablosu bulunamadı!", vbExclamation, "Hata"
Exit Sub
End If

' Yeni satır ekle
Set yeniSatir = icmalTablo.ListRows.Add

' Verileri "SABLON" sayfasından al ve "icmal" tablosuna ekle
With yeniSatir
.Range(1) = icmalTablo.ListRows.Count ' SIRA (otomatik artar)
.Range(2) = yeniTeklifNo ' TEKLİF NO.
.Range(3) = wsSablon.Range("J5").Value ' TARİH
.Range(4) = "Fatura Kaydı" ' AÇIKLAMA (İsteğe bağlı değiştirilebilir)
.Range(5) = wsSablon.Range("J4").Value ' MÜŞTERİ
.Range(6) = wsSablon.ListObjects("Toplam").DataBodyRange.Cells(1, 2).Value ' TOPLAM
.Range(7) = wsSablon.ListObjects("Toplam").DataBodyRange.Cells(2, 2).Value ' KDV
.Range(8) = wsSablon.ListObjects("Toplam").DataBodyRange.Cells(3, 2).Value ' GENEL TOPLAM
End With

' Yeni sayfa adı oluştur
yeniSayfaAdı = yeniTeklifNo & "_" & müşteriAdı & "_" & Format(tarih, "yyyy-mm-dd")

' Aynı isme sahip bir sayfa olup olmadığını kontrol et
sayfaMevcut = False
On Error Resume Next
Set mevcutSayfa = ThisWorkbook.Sheets(yeniSayfaAdı)
On Error GoTo 0

' Eğer sayfa mevcutsa, sayfaMevcut = True olur
If Not mevcutSayfa Is Nothing Then
sayfaMevcut = True
End If

' Eğer sayfa mevcut değilse, yeni sayfa oluştur
If sayfaMevcut = False Then
wsSablon.Copy After:=wsSablon
Set yeniSayfa = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
yeniSayfa.Name = yeniSayfaAdı
Else
MsgBox "Bu sayfa zaten mevcut: " & yeniSayfaAdı, vbExclamation, "Hata"
Exit Sub
End If

' "SABLON" sayfasındaki "Tarih" ve "Müşteri Adı" hücrelerini temizle
wsSablon.Range("J4").ClearContents ' MÜŞTERİ ADI
wsSablon.Range("J5").ClearContents ' TARİH

' "Urunler" tablosunun başlıkları ve 1. satırı hariç diğer satırlarını temizle
On Error Resume Next
Set urunlerTablo = wsSablon.ListObjects("Urunler")
On Error GoTo 0

If Not urunlerTablo Is Nothing Then
' Tablodaki 2. satırdan başlayarak son satıra kadar temizle
For i = urunlerTablo.ListRows.Count To 2 Step -1
urunlerTablo.ListRows(i).Delete
Next i

' 1. satırın sadece 2., 3. ve 4. sütunlarını temizle (diğer sütunlardaki formüller korunacak)
urunlerTablo.DataBodyRange.Cells(1, 2).ClearContents ' 2. sütun
urunlerTablo.DataBodyRange.Cells(1, 3).ClearContents ' 3. sütun
urunlerTablo.DataBodyRange.Cells(1, 4).ClearContents ' 4. sütun
End If

' "SABLON" sayfasındaki "Toplam" tablosundaki 2. sütunun 1. satırındaki "TOPLAM" hücresinin içeriğini temizle
wsSablon.ListObjects("Toplam").DataBodyRange.Cells(1, 2).ClearContents ' SABLON sayfasındaki "TOPLAM" hücresini temizle

' Kullanıcıya bilgi ver
MsgBox "Fatura bilgileri başarıyla kaydedildi ve yeni sayfa oluşturuldu! SABLON sayfası temizlendi.", vbInformation, "Kayıt Başarılı"
End Sub