VBA Kod Yardım C sürücüsü içine dosya kopyalama

[kalibre101]

Aşağıdaki kodda düzeltmeye ihtiyacım var,
bu kod çalıştımı
1-çalışma kitabımdaki SATIŞA ESAS adlı sayfayı kopylayıp C:\İşletme Proğramı\Satışa Esas Sayaç Endeksleri\adresine yapıştırıyor
isim olarak Sheets(54).Range("A3") & " " & trh & " " & "Satışa Esas Endeksler.xlsx" bunu veriyor
2-birinci çalışma sayfasının adını Format(Sheets(1).Range("F2"), "MMMM") bu şekilde veriyor
3-makroyu her çalıştırdığımda SATIŞA ESAS sayfasını kopyalayıp c içine oluşturduğumuz kitaba yeni sayfa ekliyor
sıkıntım bundan sonra
yeni eklediği sayfayı Format(Sheets(1).Range("F2"), "MMMM") bu formatı kullanarak önceden aynı isim varsa sonuna 1,2 gibi sayı ekleyip sayfayı eklemesini istiyorum
bir diğer sıkıntı her yeni macro çalıştırdığımda önceki eklenen sayfada değişiyor bunun olmasını istemiyorum yardımcı olursanız sevinirim

Sub SATISA_ESAS_C()
Dim yol As String, WB As Workbook, adr As String, trh As String, yol2 As String, trhm As String, a As Byte
trh = Format(Sheets(1).Range("F2"), "yyyy")
adr = Sheets(54).Range("A3") & " " & trh & " " & "Satışa Esas Endeksler.xlsx"
yol = "C:\İşletme Proğramı\Satışa Esas Sayaç Endeksleri\"
trhm = Format(Sheets(1).Range("F2"), "MMMM")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
If Dir("C:\İşletme Proğramı\", vbDirectory) = "" Then MkDir "C:\İşletme Proğramı\"
If Dir("C:\İşletme Proğramı\Satışa Esas Sayaç Endeksleri\", vbDirectory) = "" Then MkDir "C:\İşletme Proğramı\Satışa Esas Sayaç Endeksleri\"
If Dir(yol & adr) <> "" Then
Set WB = Workbooks.Open(yol & adr, False, False)
ThisWorkbook.Sheets(54).Copy After:=WB.Sheets(WB.Sheets.Count)
With WB.Sheets(WB.Sheets.Count)
.Unprotect "2227"
.DrawingObjects.Delete
For a = 1 To Sheets.Count
On Error Resume Next
If WB.Sheets(a).Name <> trhm Then
Application.Wait (Now + TimeValue("0:00:01"))
WB.Sheets(Sheets.Count).Name = trhm
Else
WB.Sheets(Sheets.Count).Name = trhm & Sheets.Count
End If
Next
End With
WB.Close 1
Else
ThisWorkbook.Sheets(54).Copy
With ActiveWorkbook.Sheets("SATIŞA ESAS")
.Unprotect "2227"
.DrawingObjects.Delete

End With
ActiveWorkbook.SaveAs yol & adr
ActiveWorkbook.Sheets(1).Name = trhm
Application.DisplayAlerts = False
ActiveWorkbook.Save
ActiveWorkbook.Close 0
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True

MsgBox "İşleminiz tamamlanmıştır.", vbInformation, "NURETTİN KOÇAK"
adr = "": yol = "": yol2 = "": yol3 = "": Set WB = Nothing: trh = "": yol2 = "": trhm = "": a = 0
End Sub