Çözüldü Makro İle Sayfa Ekleme Hatası

[ErdalÖzdemir]

Merhaba arkadaşlar.

Aşağıdaki kod ile önce klasör içerisindeki Excel dosyasına bir sayfa ekliyor ve bu eklenen sayfaya ilk sayfadaki verileri kopyalıyor, bunun üzerinde düzenlemeler yapıyorum.
Sayfa ekelerken hem kodu çalıştırdığım Excel dosyasına sayfa ekliyor hem de asıl sayfa eklemek istediğim dosyaya sayfa ekliyor. Kodu çalıştırdığım Excel dosyasına sayfa eklememesi için ne yapabiliriz.

Forum da ve internet üzerinde araştırma yaptım fakat bir sonuca ulaşamadım.

Yardımlarınız için şimdiden teşekkür ederim.

Kullandığım Kod;

Sub OZEL_OKUL_OGRETMEN()

With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With

Dim son As Long, Wb As Workbook, ws As Worksheet, i As Long, k As Long

Dim yol As String
Dim Folder As Folder

Dim FileSystem As Object
Dim fso As Scripting.FileSystemObject
Set fso = New Scripting.FileSystemObject


'HEDEF DOSYA VE KAYNAK DOSYA FARKLI KLASÖR İÇERİSİNDE İSE
yol = "E:\1- BELGELERİM\2023- 2024 İSTATİSTİKLERİ\6- VERİ TABLOLARI\ÖĞRETMEN SAYILARI\RAPORLAR (DÜZENLENEN)"

Set Folder = fso.GetFolder(yol)

For Each File In Folder.Files
If fso.GetFileName(File) Like "*ÖZEL*" Then

Set Wb = Workbooks.Open(Filename:=(File))
Set ws = Wb.Sheets(1)

Wb.Sheets(1).Activate

On Error Resume Next

son = SonSatir(Wb.Sheets(1))
'MsgBox Son
'-------------------------------------------------------------------------------
'RAPOR SAYFASINDAKİ BOŞ SATIRLARI SİL
For k = son To 2 Step -1

If Wb.Sheets(1).Cells(k, "E") = "Özel Öğretim Kursu" Or Wb.Sheets(1).Cells(k, "E") = "Özel Muhtelif Kurslar" Then
Wb.Sheets(1).Rows(k).Delete Shift:=xlUp

End If
Next k
'-------------------------------------------------------------------------------

'Sayfa eklemeyi burada yapıyorum
If Wb.Sheets.Count < 2 Then Wb.Sheets(1).Left (Sheets.Add)
'sayfasayi = Wb.Sheets.Count
' MsgBox sayfasayi
'-------------------------------------------------------------------------------------
son = SonSatir(Wb.Sheets(1)) 'son satir
'MsgBox lr
Wb.Sheets(1).Range("A1" & " :" & "K1:K" & son).ClearContents

Wb.Sheets(1).Range("A1:K1").Value = ""
Wb.Sheets(1).Range("A1:K1").Value = Array("DURUM", "İL", "İLÇE", "GENEL_MÜDÜRLÜK", _
"KURUM_TÜRÜ", "KURUM_KODU", "KURUM", "UZMANLIK", "BRANSI", "CINSIYET", "OGRT_SAYISI")

'-----------------------------------------------------------------------------------------------------------------------------------------------
Dim dizi As Variant

Set rg = Wb.Sheets(2).Range("C1").CurrentRegion
dizi = rg

For i = 2 To UBound(dizi)

'erkekogretmen = Sayfa1.Cells(i, 9)
'kadinogretmen = Sayfa1.Cells(i, 10)
'
'erkekidareci = Sayfa1.Cells(i, 11)
'kadinidareci = Sayfa1.Cells(i, 12)

If (((Wb.Sheets(2).Cells(i, 9) > 0) Or (Wb.Sheets(2).Cells(i, 11) > 0)) _
Or (Wb.Sheets(2).Cells(i, 9) = 0) Or (Wb.Sheets(2).Cells(i, 11) = 0)) Then

Son1 = SonSatir(Wb.Sheets(1)) + 1 'son satir
'MsgBox lr

Wb.Sheets(1).Cells(Son1, 1).Value = Wb.Sheets(2).Cells(i, 1)
Wb.Sheets(1).Cells(Son1, 2).Value = Wb.Sheets(2).Cells(i, 2)
Wb.Sheets(1).Cells(Son1, 3).Value = Wb.Sheets(2).Cells(i, 3)
Wb.Sheets(1).Cells(Son1, 4).Value = Wb.Sheets(2).Cells(i, 4)
Wb.Sheets(1).Cells(Son1, 5).Value = Wb.Sheets(2).Cells(i, 5)
Wb.Sheets(1).Cells(Son1, 6).Value = Wb.Sheets(2).Cells(i, 6)
Wb.Sheets(1).Cells(Son1, 7).Value = Wb.Sheets(2).Cells(i, 7)

Wb.Sheets(1).Cells(Son1, 8).Value = "" 'UZMANLIK BAŞLIĞI
Wb.Sheets(1).Cells(Son1, 9).Value = Wb.Sheets(2).Cells(i, 8) 'BRANŞ BAŞLIĞI

Wb.Sheets(1).Cells(Son1, 10).Value = "E" 'CİNSİYET BAŞLIĞI
Wb.Sheets(1).Cells(Son1, 11).Value = (Wb.Sheets(2).Cells(i, 9) + Wb.Sheets(2).Cells(i, 11)) 'EREKEK ÖĞRETEN + ERKEK YÖNETİCİ
End If
'------------------------------------------------------------------------------------------------------------------------

If (((Wb.Sheets(2).Cells(i, 10) > 0) Or (Wb.Sheets(2).Cells(i, 12) > 0)) _
Or (Wb.Sheets(2).Cells(i, 10) = 0) Or (Wb.Sheets(2).Cells(i, 12) = 0)) Then

Son1 = SonSatir(Wb.Sheets(1)) + 1 'son satir

Wb.Sheets(1).Cells(Son1, 1).Value = Wb.Sheets(2).Cells(i, 1)
Wb.Sheets(1).Cells(Son1, 2).Value = Wb.Sheets(2).Cells(i, 2)
Wb.Sheets(1).Cells(Son1, 3).Value = Wb.Sheets(2).Cells(i, 3)
Wb.Sheets(1).Cells(Son1, 4).Value = Wb.Sheets(2).Cells(i, 4)
Wb.Sheets(1).Cells(Son1, 5).Value = Wb.Sheets(2).Cells(i, 5)
Wb.Sheets(1).Cells(Son1, 6).Value = Wb.Sheets(2).Cells(i, 6)
Wb.Sheets(1).Cells(Son1, 7).Value = Wb.Sheets(2).Cells(i, 7)

Wb.Sheets(1).Cells(Son1, 8).Value = "" 'UZMANLIK BAŞLIĞI
Wb.Sheets(1).Cells(Son1, 9).Value = Wb.Sheets(2).Cells(i, 8) 'BRANŞ BAŞLIĞI

Wb.Sheets(1).Cells(Son1, 10).Value = "K" 'CİNSİYET BAŞLIĞI
Wb.Sheets(1).Cells(Son1, 11).Value = (Wb.Sheets(2).Cells(i, 10) + Wb.Sheets(2).Cells(i, 12)) 'EREKEK ÖĞRETEN + ERKEK YÖNETİCİ
End If
Next i
'------------------------------------------------------------------------------------------------------------------------------
Wb.Sheets(1).Range("A:AA").HorizontalAlignment = xlLeft 'SOLA HİZALA
Wb.Sheets(1).Rows.AutoFit
Wb.Sheets(1).Columns("A:AA").AutoFit

Wb.Close SaveChanges:=True

End If
Next File

With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With

MsgBox "ÖZEL OKUL OGRETMEN SAYILARI DOSYASI DÜZENLEDİ"

Set Wb = Nothing: Set ws = Nothing

End Sub

 

[ErdalÖzdemir]

Arkadaşlar yardıcı olabilecek yok mu

 

[maliex]

If Wb.Sheets.Count < 2 Then Wb.Sheets(1).Left (Sheets.Add)

yukarıdaki kod yerine

If Wb.Sheets.Count < 2 Then Wb.Sheets(1).Left (Wb.Sheets.Add)

veya

If Wb.Sheets.Count < 2 Then Wb.Sheets.Add

olarak değiştirip deneyebilirmisiniz

 

[ErdalÖzdemir]

Hocam denedim tamamdır. Teşekkür ederim.