Sayfa yapısı bozulmadan

Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Katılım
13 May 2019
Mesajlar
303
Excel Versiyonu
Excel 2016
Excel Sürümü
64 Bit
Excel Dili
Türkçe
Kod:
Sub sayfalari_xlsx_kaydet()
 Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
 MyFilePath$ = "C:\Servisler_xlsx"
 With Application
 .ScreenUpdating = False
 .DisplayAlerts = False
 On Error Resume Next
 MkDir MyFilePath
 For N = 4 To Sheets.Count
 Sheets(N).Activate
 SheetName = ActiveSheet.Name
 Cells.Copy
 Workbooks.Add (xlWBATWorksheet)
 With ActiveWorkbook
 With .ActiveSheet
 .Paste
 .Name = SheetName
 [A1].Select
 End With

 .SaveAs FileName:=MyFilePath _
 & "\" & SheetName & ".xlsx"
 .Close SaveChanges:=True
 End With
 .CutCopyMode = False
 Next
 End With
 Sayfa1.Activate
 End Sub
Yukarıdaki kod ile çalışma kitabındaki sayfaları belirtmiş olduğum klasör içerisine ayrı ayarı aktarabiliyorum.
Ancak orijinal dosyamda sayfa yapısı yatay olarak ayarlı olduğu halde aktarıldıktan sonra ekran görüntüsünde dikey olarak görünmekte.
Ben bunu sayfa yapısı bozulmadan yani yatak olarak , orijinal dosyamda sayfa yapısının ayarları bozulmadan aktarılmasında yardımcı olabilecek arkadaşlarımdan yardım bekliyorum. Teşekkürler.
 
Merhaba Sayın @tahsinanarat .

Aşağıdaki gibi dener misiniz.

CSS:
Sub sayfalari_xlsx_kaydet()
Dim sayfa As Worksheet, yol$, shf&
yol$ = ThisWorkbook.Path
With Application
    .ScreenUpdating = False: .DisplayAlerts = False
    On Error Resume Next
    For shf = 4 To Sheets.Count
        isim = Sheets(shf).Name: Sheets(shf).Copy
        ActiveWorkbook.SaveAs Filename:=yol & "\" & isim & ".xlsx"
        ActiveWorkbook.Close 1
    Next
    .ScreenUpdating = True: .DisplayAlerts = True
End With
Sayfa1.Activate: MsgBox "İşlem tamamlandı.", vbInformation, "::.. Ömer BARAN ..::"
End Sub

.
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Benzer Konular Popüler İçerikler Daha Fazlası
Geri
Üst Alt