Dosyalara yeni sayfa kaydetme sorunu

[sinan05]

İyi günler. Aşağıya eklemiş olduğum kodlarla klasörde nekadar dosya varsa açıp yeni sayfa kaydetmeye çalışıyorum. yeni sayfa oluşturuyor fakat "dosyam.Sheets(i) = Sheets.Add" kodu sarı yanarak hata veriyor. Nerde hata yapıyorum yardımcı olurmusunz lütfen.

Sub Kaydet12()
Application.ScreenUpdating = False
Dim evn As Object, klasoradi As String, kitap As Workbook
Dim i As Integer, x As Integer, dosyam As Workbook
Set kitap = ThisWorkbook
klasoradi = "ARAÇ KAYITLARI"
Set evn = CreateObject("scripting.filesystemobject")
Set dosyalar = evn.getfolder(ThisWorkbook.Path & Application.PathSeparator & klasoradi)
For Each klasor In dosyalar.Files
Set dosyam = Application.Workbooks.Open(klasor.Path)
For i = 1 To dosyam.Sheets.Count
For x = 1 To 1
If dosyam.Sheets(i).Cells(x, "p").Value < "3" Then
If dosyam.Sheets(i).Cells(x, "q").Value = "1" Then
dosyam.Sheets(i) = Sheets.Add

End If
End If
Next x
Next i

dosyam.Close False
Next klasor
Set evn = Nothing: Set kitap = Nothing: Set dosyam = Nothing
Application.ScreenUpdating = True
End Sub

 

[askm]

dosyam.Sheets(i) = Sheets.Add yerine dosyam.Sheets.Add yazıp deneyin.

 

[askm]

Eğer isim vermek istiyorsanız. dosyam.Sheets.Add(After:=Sheets(i)).Name = "YeniSayfa" şeklinde deneyin.

 

[sinan05]

Eğer isim vermek istiyorsanız. dosyam.Sheets.Add(After:=Sheets(i)).Name = "YeniSayfa" şeklinde deneyin.

Hocam teşekkürler. Fakat öyle yapınca sayfa eklemiyor acaba kaydet denilmediği içinmi.

 

[askm]

Adım adım giderseniz ekliyor aslında ama dosyam.Close False oldugu için kaydetmeden çıkıyorsunuz.

 

[sinan05]

Adım adım giderseniz ekliyor aslında ama dosyam.Close False oldugu için kaydetmeden çıkıyorsunuz.

Hoca peki kaydetme işlemi için hangi kodu nereye yaz alıyım.

 

[askm]

Aşağıdaki şekilde deneyin.

Sub Kaydet12()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim evn As Object, klasoradi As String, kitap As Workbook
Dim i As Integer, x As Integer, dosyam As Workbook
Set kitap = ThisWorkbook
klasoradi = "ARAÇ KAYITLARI"
Set evn = CreateObject("scripting.filesystemobject")
Set dosyalar = evn.getfolder(ThisWorkbook.Path & Application.PathSeparator & klasoradi)
On Error Resume Next
For Each klasor In dosyalar.Files
    Set dosyam = Application.Workbooks.Open(klasor.Path)
    For i = 1 To dosyam.Sheets.Count
        For x = 1 To 1
            If dosyam.Sheets(i).Cells(x, "p").Value < 3 Then
                If dosyam.Sheets(i).Cells(x, "q").Value = 1 Then
'                    dosyam.Sheets.Add
                    dosyam.Sheets.Add(After:=Sheets(i)).Name = "YeniSayfa"

                End If
            End If
        Next x
    Next i
    dosyam.Save
    dosyam.Close False
Next klasor
Set evn = Nothing: Set kitap = Nothing: Set dosyam = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[sinan05]

Aşağıdaki şekilde deneyin.

Sub Kaydet12()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim evn As Object, klasoradi As String, kitap As Workbook
Dim i As Integer, x As Integer, dosyam As Workbook
Set kitap = ThisWorkbook
klasoradi = "ARAÇ KAYITLARI"
Set evn = CreateObject("scripting.filesystemobject")
Set dosyalar = evn.getfolder(ThisWorkbook.Path & Application.PathSeparator & klasoradi)
On Error Resume Next
For Each klasor In dosyalar.Files
    Set dosyam = Application.Workbooks.Open(klasor.Path)
    For i = 1 To dosyam.Sheets.Count
        For x = 1 To 1
            If dosyam.Sheets(i).Cells(x, "p").Value < 3 Then
                If dosyam.Sheets(i).Cells(x, "q").Value = 1 Then
'                    dosyam.Sheets.Add
                    dosyam.Sheets.Add(After:=Sheets(i)).Name = "YeniSayfa"

                End If
            End If
        Next x
    Next i
    dosyam.Save
    dosyam.Close False
Next klasor
Set evn = Nothing: Set kitap = Nothing: Set dosyam = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Hocam sağolun teşekkürler dosyam.Close False yi dosyam.Close True yapınca da oluyormuş.