Birleştirme kodu

Katılım
16 Şubat 2018
Mesajlar
76
Excel Vers. ve Dili
Excel 2007
Merhaba arkadaşlar,

Aşağıdaki kod klasör içindeki tüm excel dosyalarını bir excel dosyasında toplamakta ancak aldığı dosyalardaki sütun genişliğini değiştirmekte ve noktalama işaretlerini kaldırmakta bu konuda yardımcı olabilir misiniz?

Kod:
Private Sub CommandButton1_Click()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set bukitap = ThisWorkbook
Set fso = CreateObject("scripting.filesystemobject")
For Each dosya In fso.getfolder(ThisWorkbook.Path).Files
   isim = Split(dosya.Name, ".")(0)
   If dosya.Name <> ThisWorkbook.Name And Mid(dosya.Name, 2, 1) <> "$" Then
     Set ac = Workbooks.Open(dosya)
     Sheets(1).Range("a1:l15000").Copy
     bukitap.Sheets.Add After:=Sheets(Sheets.Count)
     bukitap.ActiveSheet.Range("a65536").End(3)(2, 1).PasteSpecial xlPasteValues
     bukitap.ActiveSheet.Name = isim
     ac.Close False
   End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set ac = Nothing: Set dosya = Nothing: Set fso = Nothing
End Sub
 
Üst