Çözüldü Açılan Dosyaları Kaydet ve Kapat

E

ErdalÖzdemir

Altın Üye
Katılım
12 Ağustos 2022
Mesajlar
91
Excel Vers. ve Dili
2013 TÜRKÇE
Altın Üyelik Bitiş Tarihi
21-09-2025
Merhaba arkadaşlar.

Yapmak istediğim işlem;
Birden çok Excel dosyasını açıp bu dosyalar üzerinde işlemler yapıp sonun dada bu dosyaları Kaydederek Kapatmak istiyorum.
dosyalar üzerinde işlem yaptıktan sonra dosyalar kapanmıyor. Çok uğraştım fakat çözemedim.
Örnek dosyaları yükledim.

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

Ekli dosyalar
 

Ekli dosyalar

S

shhnyldrr

Altın Üye
Katılım
6 Haziran 2021
Mesajlar
96
Excel Vers. ve Dili
365-türkçe
Altın Üyelik Bitiş Tarihi
02-07-2025
ErdalÖzdemir' Alıntı:
Merhaba arkadaşlar.

Yapmak istediğim işlem;
Birden çok Excel dosyasını açıp bu dosyalar üzerinde işlemler yapıp sonun dada bu dosyaları Kaydederek Kapatmak istiyorum.
dosyalar üzerinde işlem yaptıktan sonra dosyalar kapanmıyor. Çok uğraştım fakat çözemedim.
Örnek dosyaları yükledim.

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

Ekli dosyalar
Genişletmek için tıkla ...
Bu kod, Excel dosyasını otomatik olarak kaydetmenizi ve kapatmanızı sağlar.
Aşağıdaki kodu kullanabilirsiniz:

Kod: 
Sub AutoCloseAndSave()

' Kaydet ve dosyayı kapat

ActiveWorkbook.Close SaveChanges:=True

End Sub
Bu kodu Excel dosyasında çalıştırmak için, aşağıdaki adımları izleyin:
  1. Excel dosyasını açın ve "Alt + F11" tuşlarına basarak VBA penceresini açın.
  2. "Modül" ekleyin ve "Modül1" oluşturun.
  3. Kodu yukarıdaki gibi kopyalayın ve yapıştırın.
  4. "Alt + Q" tuşlarına basarak VBA penceresini kapatın.
  5. Dosyayı kaydetmek istediğinizde "Alt + F8" tuşlarına basarak kod listesini açın ve "AutoCloseAndSave" adlı kodu çalıştırın.
Bu kod, Excel dosyasını otomatik olarak kaydeder ve kapatır.
 
E

ErdalÖzdemir

Altın Üye
Katılım
12 Ağustos 2022
Mesajlar
91
Excel Vers. ve Dili
2013 TÜRKÇE
Altın Üyelik Bitiş Tarihi
21-09-2025
Hocam Teşekkür ederim.

Ekli dosyadada beliritiğim kod üzerinde işlem yapatıktan sonra kaydedip kapatmıyor.

Sub PROJE_BİLGİLERİ()

Dim son As Long, wb As Workbook, wsa As Worksheet, i As Long, k As Long

With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With

Dim Kaynak As String
Dim Hedef As String

Dim Fso As Scripting.FileSystemObject
Set Fso = New Scripting.FileSystemObject

Dim vaFiles As Variant

On Error Resume Next

' BURADA; .xlsx UZANTILI DOSYALAR HEDEF KLASÖRE KOPYELNDI
Kaynak = _
"C:\Users\ErdalOZDEMIR\Desktop\DENEME\RAPORLAR (ASIL)"

Hedef = _
"C:\Users\ErdalOZDEMIR\Desktop\DENEME\RAPORLAR (DÜZENLENEN)"

Fso.CopyFile Kaynak & "\*.xlsx*", Hedef
'-------------------------------------------------

Dim yol As String
yol = "C:\Users\ErdalOZDEMIR\Desktop\DENEME\RAPORLAR (DÜZENLENEN)"

Set vaFiles = Fso.GetFolder(yol)

For Each File In vaFiles.Files
If LCase(Fso.GetExtensionName(File)) Like "*xlsx*" Then
' If Fso.GetFileName(File) Like "*RESMİ*" Then _
' Or Fso.GetFileName(File) Like "*Özel*"

'If Left(Fso.GetExtensionName(File.Name), 2) = "xl" Then
'Get Extension Name: Uzantı Adını Alın (ÖR:'xlsm , xlsx)

Set wb = Workbooks.Open(File, False, True)
Set wsa = wb.Sheets(1)

son = SonSatir(wsa)

On Error Resume Next

wsa.Range("A1").Value = "İL"
wsa.Range("C1").Value = "İLÇE"
wsa.Range("D1").Value = "GENEL_MÜDÜRLÜK"
wsa.Range("G1").Value = "KURUM_KODU"
wsa.Range("I1").Value = "KURUM_ADI"
wsa.Range("M1").Value = "KURUM_TÜRÜ"

wsa.Range("N1").Value = "UYGULANAN_PROGRAM_PROJE_ADI"
wsa.Range("O1").Value = "OKUL_SAYISI"


For k = 2 To son

If wsa.Cells(k, "D") = "Ortaöğretim Genel Müdürlüğü" And _
wsa.Cells(k, "I") Like "*Anadolu Lisesi*" Then
wsa.Cells(k, "M") = "Anadolu Lisesi"
End If

If wsa.Cells(k, "D") = "Ortaöğretim Genel Müdürlüğü" And _
wsa.Cells(k, "I") Like "*Sosyal Bilimler Lisesi*" Then
wsa.Cells(k, "M") = "Sosyal Bilimler Lisesi"
End If

If wsa.Cells(k, "D") = "Ortaöğretim Genel Müdürlüğü" And _
wsa.Cells(k, "I") Like "*Fen*" Then
wsa.Cells(k, "M") = "Fen Lisesi"
End If
'-----------------------------------------------------------------------------------------
If wsa.Cells(k, "D") Like "*Mesleki*" And _
wsa.Cells(k, "I") Like "*Mesleki ve Teknik Anadolu*" Then
wsa.Cells(k, "M") = "Mesleki ve Teknik Anadolu Lisesi"
End If
'----------------------------------------------------------------------------------------
If wsa.Cells(k, "D") Like "*Din*" And _
wsa.Cells(k, "I") Like "*İmam Hatip Lisesi*" Then
wsa.Cells(k, "M") = "Anadolu İmam Hatip Lisesi"
End If

' İmam Hatip Ortaokulu(İHO)
If wsa.Cells(k, "D") = "Din Öğretimi Genel Müdürlüğü(İHO)" And _
wsa.Cells(k, "I") Like "*İmam Hatip Ortaokulu*" Then
wsa.Cells(k, "M") = "İmam Hatip Ortaokulu"
End If

'OKUL SAYISINI YAZDIRMA
If wsa.Cells(k, "G") <> "" Then
wsa.Cells(k, "O") = 1
End If
Next k

If wsa.Range("G2:G") = "" Then
wsa.Range("D2:D" & son).Value = Mid(File.Name, 1, InStr(File.Name, ".") - 1)
End If
'wsa.Range("D2:D" & son).Value = FileSystem.GetFileName(File.Name) ' UZANTISYLA BİRLİKTE YAZDIRMA

son1 = SonSatir(wsa)

For i = son1 To 2 Step -1
If wsa.Cells(i, "I") = "" Then
wsa.Cells.Rows(i).Delete
End If
Next i

wsa.UsedRange.EntireColumn.AutoFit
wsa.UsedRange.EntireRow.AutoFit


End If

wb.Close SaveChanges:=True
Next File

Set wsa = Nothing: Set vaFiles = Nothing

MsgBox "KAYITLAR TAMAM"

With Application
.DisplayAlerts = True
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationManual
End With


End Sub
 
S

shhnyldrr

Altın Üye
Katılım
6 Haziran 2021
Mesajlar
96
Excel Vers. ve Dili
365-türkçe
Altın Üyelik Bitiş Tarihi
02-07-2025
ErdalÖzdemir' Alıntı:
Hocam Teşekkür ederim.

Ekli dosyadada beliritiğim kod üzerinde işlem yapatıktan sonra kaydedip kapatmıyor.

Sub PROJE_BİLGİLERİ()

Dim son As Long, wb As Workbook, wsa As Worksheet, i As Long, k As Long

With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With

Dim Kaynak As String
Dim Hedef As String

Dim Fso As Scripting.FileSystemObject
Set Fso = New Scripting.FileSystemObject

Dim vaFiles As Variant

On Error Resume Next

' BURADA; .xlsx UZANTILI DOSYALAR HEDEF KLASÖRE KOPYELNDI
Kaynak = _
"C:\Users\ErdalOZDEMIR\Desktop\DENEME\RAPORLAR (ASIL)"

Hedef = _
"C:\Users\ErdalOZDEMIR\Desktop\DENEME\RAPORLAR (DÜZENLENEN)"

Fso.CopyFile Kaynak & "\*.xlsx*", Hedef
'-------------------------------------------------

Dim yol As String
yol = "C:\Users\ErdalOZDEMIR\Desktop\DENEME\RAPORLAR (DÜZENLENEN)"

Set vaFiles = Fso.GetFolder(yol)

For Each File In vaFiles.Files
If LCase(Fso.GetExtensionName(File)) Like "*xlsx*" Then
' If Fso.GetFileName(File) Like "*RESMİ*" Then _
' Or Fso.GetFileName(File) Like "*Özel*"

'If Left(Fso.GetExtensionName(File.Name), 2) = "xl" Then
'Get Extension Name: Uzantı Adını Alın (ÖR:'xlsm , xlsx)

Set wb = Workbooks.Open(File, False, True)
Set wsa = wb.Sheets(1)

son = SonSatir(wsa)

On Error Resume Next

wsa.Range("A1").Value = "İL"
wsa.Range("C1").Value = "İLÇE"
wsa.Range("D1").Value = "GENEL_MÜDÜRLÜK"
wsa.Range("G1").Value = "KURUM_KODU"
wsa.Range("I1").Value = "KURUM_ADI"
wsa.Range("M1").Value = "KURUM_TÜRÜ"

wsa.Range("N1").Value = "UYGULANAN_PROGRAM_PROJE_ADI"
wsa.Range("O1").Value = "OKUL_SAYISI"


For k = 2 To son

If wsa.Cells(k, "D") = "Ortaöğretim Genel Müdürlüğü" And _
wsa.Cells(k, "I") Like "*Anadolu Lisesi*" Then
wsa.Cells(k, "M") = "Anadolu Lisesi"
End If

If wsa.Cells(k, "D") = "Ortaöğretim Genel Müdürlüğü" And _
wsa.Cells(k, "I") Like "*Sosyal Bilimler Lisesi*" Then
wsa.Cells(k, "M") = "Sosyal Bilimler Lisesi"
End If

If wsa.Cells(k, "D") = "Ortaöğretim Genel Müdürlüğü" And _
wsa.Cells(k, "I") Like "*Fen*" Then
wsa.Cells(k, "M") = "Fen Lisesi"
End If
'-----------------------------------------------------------------------------------------
If wsa.Cells(k, "D") Like "*Mesleki*" And _
wsa.Cells(k, "I") Like "*Mesleki ve Teknik Anadolu*" Then
wsa.Cells(k, "M") = "Mesleki ve Teknik Anadolu Lisesi"
End If
'----------------------------------------------------------------------------------------
If wsa.Cells(k, "D") Like "*Din*" And _
wsa.Cells(k, "I") Like "*İmam Hatip Lisesi*" Then
wsa.Cells(k, "M") = "Anadolu İmam Hatip Lisesi"
End If

' İmam Hatip Ortaokulu(İHO)
If wsa.Cells(k, "D") = "Din Öğretimi Genel Müdürlüğü(İHO)" And _
wsa.Cells(k, "I") Like "*İmam Hatip Ortaokulu*" Then
wsa.Cells(k, "M") = "İmam Hatip Ortaokulu"
End If

'OKUL SAYISINI YAZDIRMA
If wsa.Cells(k, "G") <> "" Then
wsa.Cells(k, "O") = 1
End If
Next k

If wsa.Range("G2:G") = "" Then
wsa.Range("D2:D" & son).Value = Mid(File.Name, 1, InStr(File.Name, ".") - 1)
End If
'wsa.Range("D2:D" & son).Value = FileSystem.GetFileName(File.Name) ' UZANTISYLA BİRLİKTE YAZDIRMA

son1 = SonSatir(wsa)

For i = son1 To 2 Step -1
If wsa.Cells(i, "I") = "" Then
wsa.Cells.Rows(i).Delete
End If
Next i

wsa.UsedRange.EntireColumn.AutoFit
wsa.UsedRange.EntireRow.AutoFit


End If

wb.Close SaveChanges:=True
Next File

Set wsa = Nothing: Set vaFiles = Nothing

MsgBox "KAYITLAR TAMAM"

With Application
.DisplayAlerts = True
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationManual
End With


End Sub
Genişletmek için tıkla ...
Sanırım, dosyanızın kaydedilmemesi problemine sebep olan kod satırı şu şekildedir:
Set vaFiles = Fso.GetFolder(yol)
Bu satırda, Fso.GetFolder methodunun sonucu vaFiles değişkenine atanıyor. Bu method bir klasörü döndürür, ancak burada bir dosya açılmış ve açılan dosyanın özelliklerine erişmek için kullanılmış. Bu yüzden, vaFiles değişkeni hiçbir şeyi temsil etmez ve dosya kaydedilememektedir.
Dosyanızı kaydetmek istediğiniz yerde, Workbook.Save methodunu kullanarak dosyayı kaydedebilirsiniz. Örnek olarak:
wb.Save
Bu şekilde, açılan dosya kaydedilecektir.
 
E

ErdalÖzdemir

Altın Üye
Katılım
12 Ağustos 2022
Mesajlar
91
Excel Vers. ve Dili
2013 TÜRKÇE
Altın Üyelik Bitiş Tarihi
21-09-2025
Hocam çözümü nedir.
Birçok kaydet kapat yöntemini denedim olmadı
 
E

ErdalÖzdemir

Altın Üye
Katılım
12 Ağustos 2022
Mesajlar
91
Excel Vers. ve Dili
2013 TÜRKÇE
Altın Üyelik Bitiş Tarihi
21-09-2025
Yokmu yardımcı olabilecek
 
N

necati

Katılım
20 Şubat 2007
Mesajlar
655
Excel Vers. ve Dili
2007 Excel, Word Tr
Merhaba Erdal bey,
Başlangıçta dosyalarınızı salt okunur olarak açtığınız için çözüm önerenlerin çözümleri sonuçsuz kalıyor. 3. mesajda verdiğiniz koddaki şu satırı
Kod: 
Set wb = Workbooks.Open(File, False, True)
şu şekilde değiştiriniz. Kayıt yapma açılacaktır.
Kod: 
Set wb = Workbooks.Open(File, False, False)
 
E

ErdalÖzdemir

Altın Üye
Katılım
12 Ağustos 2022
Mesajlar
91
Excel Vers. ve Dili
2013 TÜRKÇE
Altın Üyelik Bitiş Tarihi
21-09-2025
Necati Hocam;
Bir haftadır aynı konuyu silip silip tekrar açıyordum. Bir türlü cevap alamıyordum.
Elinize emeğinize sağlık, teşekkür ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst