onurcan1979
Altın Üye
- Katılım
- 29 Mayıs 2010
- Mesajlar
- 186
- Excel Vers. ve Dili
- 2003 tr
- Altın Üyelik Bitiş Tarihi
- 23/10/2025
Önceden bu kodu kullanıyordum çok ta güzel çalışıyordu şimdi bu koddan yedek alamıyorum
Özel Alt CommandButton11_Click ()
Uygulama ile
.ScreenUpdating = Yanlış
.EnableEvents = Yanlış
.DisplayAlerts = Yanlış
İle bitmek
git = ActiveSheet.Name
Klasor = ThisWorkbook.Path & "\ RAPOR \"
Hatada Devam Et Sonraki
Dir (Klasor) = "" O zaman MkDir Klasor
Dim ds, bir
Ds = CreateObject ("Scripting.FileSystemObject") ayarlayın
Dim Sayfa Çalışma Sayfası
Dim myArray () Değişken Olarak
Tamsayı Olarak Dim i
Tamsayı Olarak Dim j
j = 0
İ = 1 To Sheets.Count için
r = 0
Sayfalar (i) .Name = "KONTEYNER.GİRİŞ" ise
r = 1
ElseIf Sheets (i) .Name = "DEPO.ÇIKIŞ.RAPOR" Sonra
r = 1
ElseIf Sheets (i) .Name = "KAPALI.DEPO.GİRİŞ" O halde
r = 1
ElseIf Sheets (i) .Name = "K.DEPO.ÇIKIŞ.RAPOR" Sonra
r = 1
Bitiş Eğer
R = 1 ise
ReDim myArray'i Koru (j)
myArray (j) = i
j = j + 1
Bitiş Eğer
Sonraki ben
E-Tablolar (myArray).
E-Tablolar (myArray) .Copy
İ = 1 To Len için (ThisWorkbook.Name)
Mid (ThisWorkbook.Name, i, 1) = ".xlsx" ise
Dosya_adi = Orta (ThisWorkbook.Name, 1, i - 1)
uzanti = Orta (ThisWorkbook.Name, i, Len (ThisWorkbook.Name))
Bitiş Eğer
Sonraki
CreateObject'teki ("Scripting.FileSystemObject") Her Dosya İçin GetFolder (Klasor) .Files
Orta (Dosya.Adı, 1, Len (Dosya_adi)) = Dosya_adi Sonra
oturdu = oturdu + 1
a = ds.FileExists (Klasor & "\" & Dosya_adi & sat & uzanti)
Eğer a = Doğru O zaman
Başka
Oğlu = 1
Çıkış
Bitiş Eğer
Bitiş Eğer
Sonraki
Oğul = 0 ise O zaman
oturdu = oturdu + 1
Bitiş Eğer
deger = Dosya_adi & otur & uzanti
İ = 1 için ActiveWorkbook.Sheets.Count'a
ActiveWorkbook.Sheets (Sheets (i] .Name).
Dim X Aralık Olarak
Her X Giriş için [A1: K30]
Eğer X.Value <> "" O zaman
X.Value = X.Value
Bitiş Eğer
Sonraki X
Sonraki
ActiveWorkbook.Sheets (Sheets (1] .Name).
ActiveWorkbook.SaveAs Klasor & "\" & deger
ActiveWorkbook.Close SaveChanges: = Yanlış
E-Tablolar (git).
Uygulama ile
.ScreenUpdating = Doğru
.EnableEvents = Doğru
.DisplayAlerts = Doğru
İle bitmek
MsgBox Klasor & "\" & deger & Chr (10) & Chr (10) & _
"Kayıt yapıldı", vbInformation, deger
Sub
Özel Alt CommandButton11_Click ()
Uygulama ile
.ScreenUpdating = Yanlış
.EnableEvents = Yanlış
.DisplayAlerts = Yanlış
İle bitmek
git = ActiveSheet.Name
Klasor = ThisWorkbook.Path & "\ RAPOR \"
Hatada Devam Et Sonraki
Dir (Klasor) = "" O zaman MkDir Klasor
Dim ds, bir
Ds = CreateObject ("Scripting.FileSystemObject") ayarlayın
Dim Sayfa Çalışma Sayfası
Dim myArray () Değişken Olarak
Tamsayı Olarak Dim i
Tamsayı Olarak Dim j
j = 0
İ = 1 To Sheets.Count için
r = 0
Sayfalar (i) .Name = "KONTEYNER.GİRİŞ" ise
r = 1
ElseIf Sheets (i) .Name = "DEPO.ÇIKIŞ.RAPOR" Sonra
r = 1
ElseIf Sheets (i) .Name = "KAPALI.DEPO.GİRİŞ" O halde
r = 1
ElseIf Sheets (i) .Name = "K.DEPO.ÇIKIŞ.RAPOR" Sonra
r = 1
Bitiş Eğer
R = 1 ise
ReDim myArray'i Koru (j)
myArray (j) = i
j = j + 1
Bitiş Eğer
Sonraki ben
E-Tablolar (myArray).
E-Tablolar (myArray) .Copy
İ = 1 To Len için (ThisWorkbook.Name)
Mid (ThisWorkbook.Name, i, 1) = ".xlsx" ise
Dosya_adi = Orta (ThisWorkbook.Name, 1, i - 1)
uzanti = Orta (ThisWorkbook.Name, i, Len (ThisWorkbook.Name))
Bitiş Eğer
Sonraki
CreateObject'teki ("Scripting.FileSystemObject") Her Dosya İçin GetFolder (Klasor) .Files
Orta (Dosya.Adı, 1, Len (Dosya_adi)) = Dosya_adi Sonra
oturdu = oturdu + 1
a = ds.FileExists (Klasor & "\" & Dosya_adi & sat & uzanti)
Eğer a = Doğru O zaman
Başka
Oğlu = 1
Çıkış
Bitiş Eğer
Bitiş Eğer
Sonraki
Oğul = 0 ise O zaman
oturdu = oturdu + 1
Bitiş Eğer
deger = Dosya_adi & otur & uzanti
İ = 1 için ActiveWorkbook.Sheets.Count'a
ActiveWorkbook.Sheets (Sheets (i] .Name).
Dim X Aralık Olarak
Her X Giriş için [A1: K30]
Eğer X.Value <> "" O zaman
X.Value = X.Value
Bitiş Eğer
Sonraki X
Sonraki
ActiveWorkbook.Sheets (Sheets (1] .Name).
ActiveWorkbook.SaveAs Klasor & "\" & deger
ActiveWorkbook.Close SaveChanges: = Yanlış
E-Tablolar (git).
Uygulama ile
.ScreenUpdating = Doğru
.EnableEvents = Doğru
.DisplayAlerts = Doğru
İle bitmek
MsgBox Klasor & "\" & deger & Chr (10) & Chr (10) & _
"Kayıt yapıldı", vbInformation, deger
Sub