Kod:
Private Sub CommandButton3_Click() 'Mesai kaydı getir
Dim son 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
d31 = Range("D31").Value
e13 = Range("E13").Value
'dosya = ThisWorkbook.Path & Application.PathSeparator & e13 & ".xlsx"
dosya = ThisWorkbook.Path & Application.PathSeparator & Format(e13, "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
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
Set ws = wb.Worksheets(d31)
Else
MsgBox d31 & vbNewLine & "Bulunamadi.." _
, vbCritical, "Hata": wb.Close 0: GoTo son
End If
Else
MsgBox Format(e13, "mmmm yyyy") & ".xlsx" & vbNewLine & "Bulunamadi.." _
, vbCritical, "Hata": wb.Close 0: GoTo son
End If
son = ws.Cells(Rows.Count, 1).End(3).Row
With ws
Application.DisplayAlerts = False
.Range(.Cells(5, "F"), .Cells(son, "aj")).Copy
ThisWorkbook.Activate
Range("F41").PasteSpecial xlPasteValuesAndNumberFormats
End With
wb.Close 0
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