- Katılım
- 25 Ocak 2006
- Mesajlar
- 763
- Excel Vers. ve Dili
- 2019 tr
- Altın Üyelik Bitiş Tarihi
- 04-01-2024
Kod:
.
.
......
End If
Dosyam = ThisWorkbook.Path & "\BİRLEŞTİRMELER\FORM-BÖLGE.xlsx"
If Dir(Dosyam) <> "" Then
Kill Dosyam
End If
Set w1 = Workbooks.Add
w1.SaveAs Filename:=Dosyam, FileFormat:=xlOpenXMLWorkbook
Path = ThisWorkbook.Path & "\SERVİSLER\FORM\Bölge \"
Filename = Dir(Path & "*.xlsx")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
ActiveSheet.Name = Replace(Replace(Replace(Replace(Replace(Left(ActiveSheet.Range("w2"), 31), ":", "-"), "/", "-"), "(", ""), ")", ""), "*", "-")
Sheet.Copy After:=w1.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
Call SortSheetsTabName
w1.Save 'Dosyayı kaydeder
w1.Close 'Dosyayı kapatır
bekle = ""
MsgBox "Birleştirme Tamamlandı", vbInformation
End Sub
