Çalışma Kitabı Dışarı Aktarma Hakkında Yardım

[k_1994]

merhabalar,
excel çalışma sayfam var ve içinde 15 sayfa çalışma kitabım var ben bu 15 çalışma kitabını tek tek excel sayfası olarak dışarı aktarmak istiyorum bunun basit bir yolu varmı çünkü elimde çok fazla sayfa var yardımlarınızı bekliyorum

Örnek yuvarlak içine aldıgım sayfaları dısarı tek bir excel sayfası olarak ayırmak istiyorum

iyi çalışmalar

 

[tahsinanarat]

Kitap ismiyle klasör oluşturup, her sayfayı ayrı ayrı kayıt eder
Not: kodlar evvelce bu siteden temin edilmiştir.

Option Explicit

Sub sayfalari_ayir_kaydet()
    Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
    MyFilePath$ = ActiveWorkbook.Path & "\" & _ 
    Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
    With Application
        .ScreenUpdating = False 
        .DisplayAlerts = False
         On Error Resume Next
        MkDir MyFilePath
        For N = 1 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

 

[k_1994]

Teşekkürler yardımınız için işime yaradı

 

[Tevfik_Kursun]

Sayın Tahsin Anarat Arkadaşım,
Teşekkür ederim.
Bu kodların bir de birleştirme yapanı yok mudur elinizde?
Saygılarımla

 

[tahsinanarat]

Aynı sayfada birleştirme yapar

Sub kitapbirlestir()

Dim bkLst As Workbook
Dim mObj As Object, dObj As Object, fObj As Object, eObj As Object
Application.ScreenUpdating = False
Set mObj = CreateObject("Scripting.FileSystemObject")

Set dObj = mObj.Getfolder("c:\deneme\") ' Dosya yolunu kendinize uyarlayın.
Set fObj = dObj.Files
For Each eObj In fObj
Set bkLst = Workbooks.Open(eObj)

Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy ' "A2" başlangıç hücresini kendi verilerinize göre ayarlayın.

ThisWorkbook.Worksheets(1).Activate
 
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False

bkLst.Close

Next

End Sub

 

[tahsinanarat]

'Gösterdiğiniz sürücü altındaki çalışma kitaplarının sayfaları çalıştığınız kitaba ekler

Option Explicit

Sub CombineFiles()

Dim Path            As String
Dim FileName        As String
Dim Wkb             As Workbook
Dim WS              As Worksheet

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Path = "C:\Deneme" 'Sürücü değiştirilebilir
    FileName = Dir(Path & "\*.xls", vbNormal)
    Do Until FileName = ""
        Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
        For Each WS In Wkb.Worksheets
            WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        Next WS
        Wkb.Close False
        FileName = Dir()
    Loop
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub  ]

 

[tahsinanarat]

Dim Klasor As Object
Dim Kaynak As String
Dim Sayfa_Adı As String
Dim dosya_adı As String

Sub klasordekisayfalarıkopyala()
dosya_adı = ActiveWorkbook.Name
Sayfa_Adı = ActiveSheet.Name
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.Items.Item.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
Call Liste1(Kaynak, "")
Sheets(Sayfa_Adı).Select
ActiveWindow.WindowState = xlMaximized
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
Set Obj = Nothing
Set Klasor = Nothing
End Sub

 

[Tan Yark]

Dim Klasor As Object
Dim Kaynak As String
Dim Sayfa_Adı As String
Dim dosya_adı As String

Sub klasordekisayfalarıkopyala()
dosya_adı = ActiveWorkbook.Name
Sayfa_Adı = ActiveSheet.Name
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.Items.Item.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
Call Liste1(Kaynak, "")
Sheets(Sayfa_Adı).Select
ActiveWindow.WindowState = xlMaximized
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
Set Obj = Nothing
Set Klasor = Nothing
End Sub

Tahsin Bey merhaba,

Benimde bir sorum olacak cevaplayabilceğinizi umuyorum.

Excelde bir çalışma sayfasını buton ekleyip butona VBA macro atayıp, dışarı export etmek istiyorum.
Fakat sayfa yapısı ve düzeni bozulmadan ama formulleri almayarak.
Aşağıda ki gibi bir şey denedim internette edeindiğim bilgilere göre fakat pasteSpecial yüzünden bütün sayfa yapısı ve sayfadaki resim bozuluyor. Resmi alamıyorum ama formullerden kurtulmuş oluyorum.
Sayfayı düzgün bir şekilde Macro ile export etmek benim için öncelikli formullerden kurtulmak yerine nasıl bir şey deneyebilirim?
Ve masaüstüne kaydediyordum dosyanın bulunduğu konuma otomatik kaydetmem mümkünmüdür?

Yardımcı olabilirseniz çok seviinirim.

Saygılarımla

Sub SaveValuesOnly()
Dim wsCopy As Worksheet, wsPaste As Worksheet
Dim wb As Workbook
Dim sFileName As String, sPath As String


'Path to store new file
sPath = "C:\Users\t.yarkin\Desktop\"
'Change filename as required
sFileName = "ST06-F133 Şartname" & Format(Range("E1"), "Mmm yy")

'set the sheet you are copying. Change where neccessary
Set wsCopy = ThisWorkbook.Worksheets("ST06-F133 Şartname")
Set wb = Workbooks.Add
Set wsPaste = wb.Sheets(1)

'Copy everything from copy sheet
wsCopy.Cells.Copy
'Paste Values only
wsPaste.Cells.PasteSpecial xlPasteValues

Application.CutCopyMode = False


'Save new workbook

wsPaste.Name = "ST06-F133 Şartname" 'Change if needed
wb.SaveAs Filename:=sPath & sFileName, FileFormat:=xlOpenXMLWorkbook

MsgBox ("Done.")


End Sub

 

[Korhan Ayhan]

Sayfadaki hücreleri kopyalamak yerine sayfayı komple taşı ve kopyala komutu ile yeni kitaba taşımalısınız. Bu şekilde sayfa yapısı bozulmaz. Sonra formülleri kolaylıkla değere çevirebilirsiniz.

 

[Tan Yark]

Sayfadaki hücreleri kopyalamak yerine sayfayı komple taşı ve kopyala komutu ile yeni kitaba taşımalısınız. Bu şekilde sayfa yapısı bozulmaz. Sonra formülleri kolaylıkla değere çevirebilirsiniz.

Çok Teşekkür ederim.

Bir husus daha var pdf export ederken bir hücredeki metni dosya ismi olarak almak istiyorum.

Sub pdfex()
'
' pdfex Macro
'

'
ActiveWorkbook.PrintOut From:=3, To:=5, Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
End Sub


Ne eklemem gerekli?

Yardımcı olur musunuz?

 

[Korhan Ayhan]

Exporttan kastınız nedir?