Kodu alttaki gibi değiştirin.
Son sütun no tam bulunamıyor kodda birleştirmeden dolayı galiba.
Ben Const sonSutun As String = "AY" olarak ekleme yaptım gerekirse değiştirin orayı.
Private Sub CommandButton2_Click() 'kaydet
Dim son As Long, son2 As Long, i As Long, syfAra As Worksheet
Dim wb As Workbook, ws As Worksheet, dosya As String, say As Integer
Dim d31 As String, e13 As String, yol As String
Dim sonSutun As Integer
yol = ""
Const basSatir As Integer = 41
Const secim As Integer = 31
Const ilksutun As Integer = 6
Const sonSutun As String = "AY"
d31 = Range("D31").Value
e13 = Range("E13").Value
son2 = Cells(Rows.Count, 1).End(3).Row
If son2 < basSatir Then GoTo son
For i = basSatir To son2
' If Not IsNumeric(Cells(i, 1).Value) Then: son = i - 1: Exit For
If Val(Cells(i, 1).Value) = 0 Then: son = i - 1: Exit For
Next
'dosya = ThisWorkbook.Path & Application.PathSeparator & e13 & ".xlsx"
dosya = ThisWorkbook.Path & Application.PathSeparator & Format(e13, "Mesai mmmm yyyy") & ".xlsx"
'dosya = yol & Application.PathSeparator & Format(e13, "mmmm yyyy") & ".xlsx"
say = 0
If Dir(dosya) = "" Then 'Klasörde E13 deki veri ile ayni isimde Excel yoksa
If kontroluzunluk(d31) = True Then GoTo son
Set wb = Workbooks.Add
Set ws = wb.Sheets(1)
ws.Name = d31
Else 'Klasörde E13 deki veri ile ayni isimde Excel yokvarsasa
Set wb = Workbooks.Open(dosya)
For Each syfAra In wb.Worksheets
If syfAra.Name = d31 Then
say = say + 1
Exit For
End If
Next
If say = 0 Then 'Kapali excelde D31 deki adla ayni isimd sayfa yoksa
If kontroluzunluk(d31) = True Then GoTo son
wb.Sheets.Add
Set ws = wb.ActiveSheet
ws.Name = d31
Else 'Kapali excelde D31 deki adla ayni isimd sayfa varsa
Set ws = wb.Worksheets(d31)
End If
End If
ThisWorkbook.Activate
Application.DisplayAlerts = False
ws.Cells.Clear
Range(Cells(secim, "A"), Cells(son, sonSutun)).Copy ws.Range("A1")
Range(Cells(secim, "A"), Cells(son, sonSutun)).Copy
ws.Range("A1").PasteSpecial xlPasteColumnWidths
ws.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
wb.SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator & Format(e13, "Mesai mmmm yyyy") & ".xlsx"
'wb.SaveAs Filename:=yol & Application.PathSeparator & Format(e13, "mmmm yyyy") & ".xlsx"
wb.Close
Application.CutCopyMode = False
Set wb = Nothing: Set ws = Nothing
Application.DisplayAlerts = True
son:
Application.CutCopyMode = False
Set wb = Nothing: Set ws = Nothing
Application.DisplayAlerts = True
End Sub