Merhaba,
Sorudan soruyu anlamamıştım ama çözümünüzden soruyu anladım
Bunun için yapay zekadan bir kod alıp uyarladım.
Diyelim formatını 97-2003 yapmak istediğiniz 100 adet excel var bir klasöre bunları toplayın.
Örneğin, Masaüstünde DENEME olsun adı,
Kodda bu dosya yolu değiştirin aşağıda belirttiğim satırı.
Şunu yapıyor, içine atılan dosyaları kendisi açıp farklı kaydet yapıp değiştirilenler adında yeni bir klasör açıp içine atıyor.
Değişenler DENEME nin içinde kalmaya devam ediyor, değişmişlerde Değiştirilenler isimli klasörün içine atılmış oluyor.
17 yıllık çok fazla dosyayı tek tek değiştirmek çok zor olmayacağını düşünüp işinize yarar diye iletmek istedim.
folderPath = "
C:\Users\Dosya Yolu\" ' Buraya klasör yolunu yazın sondaki \ olması gerekli.
Bu koyu yazdığım yere formatını değiştirmek istediğiniz excelleri atacağınız klasörün yolunu yazacaksınız.
Kod:
Sub Excel972003()
Dim folderPath As String
Dim newFolderPath As String
Dim fileName As String
Dim wb As Workbook
Application.ScreenUpdating = False
' Klasör yolunu belirtin
folderPath = "C:\Users\Dosya Yolu\" ' Buraya klasör yolunu yazın sondaki \ olması gerekli.
newFolderPath = folderPath & "Değiştirilenler\"
' Değiştirilenler klasörünü oluştur
If Dir(newFolderPath, vbDirectory) = "" Then
MkDir newFolderPath
End If
' Klasördeki ilk dosyayı al
fileName = Dir(folderPath & "*.xlsx")
' Klasördeki tüm dosyaları dönüştür ve taşı
Do While fileName <> ""
' Çalışma kitabını aç
Set wb = Workbooks.Open(folderPath & fileName)
' Dosyayı Excel 97-2003 formatında kaydet
wb.SaveAs newFolderPath & Replace(fileName, ".xlsx", ".xls"), FileFormat:=xlExcel8
' Çalışma kitabını kapat
wb.Close SaveChanges:=False
' Sonraki dosyayı al
fileName = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Tüm dosyalar dönüştürüldü ve taşındı!"
End Sub
