[]
excel sorusu (kolay yolu var mı)
altında 10'dan fazla sayfa (sheet) olan bir excel dosyam var. bu sheet'lerin her birinin ayrı ayrı excel dosyası haline gelmesi gerek.
sayfayı sağ tıkla, taşı veya kopyala, yeni kitap'ı seç, tamam de, yeni oluşana git, kaydet de, dosya ismi ver.
orijinal dosyaya geri dön ve onlarca sayfa için bunu tekrar yap.
kolay bir yolu yok mu? tek dosyadaki onlarca sayfayı parçalayıp her birini ayrı excel dosyası olarak kaydetsin. dosya isimleri de sayfa ismi olsun.
bana bir kolayı vardır gibi geliyor.
sayfayı sağ tıkla, taşı veya kopyala, yeni kitap'ı seç, tamam de, yeni oluşana git, kaydet de, dosya ismi ver.
orijinal dosyaya geri dön ve onlarca sayfa için bunu tekrar yap.
kolay bir yolu yok mu? tek dosyadaki onlarca sayfayı parçalayıp her birini ayrı excel dosyası olarak kaydetsin. dosya isimleri de sayfa ismi olsun.
bana bir kolayı vardır gibi geliyor.
selam bununla yapabilirsin
Sub MSG()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim FilePath As String
Dim NewWorkbook As Workbook
FilePath = ThisWorkbook.Path
If Dir(FilePath, vbDirectory) = "" Then
MkDir FilePath
End If
For Each ws In ThisWorkbook.Worksheets
ws.Copy
Set NewWorkbook = ActiveWorkbook
NewWorkbook.SaveAs FilePath & "\" & ws.Name & ".xlsx"
NewWorkbook.Close SaveChanges:=False
Next ws
Application.ScreenUpdating = True
End Sub
Sub MSG()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim FilePath As String
Dim NewWorkbook As Workbook
FilePath = ThisWorkbook.Path
If Dir(FilePath, vbDirectory) = "" Then
MkDir FilePath
End If
For Each ws In ThisWorkbook.Worksheets
ws.Copy
Set NewWorkbook = ActiveWorkbook
NewWorkbook.SaveAs FilePath & "\" & ws.Name & ".xlsx"
NewWorkbook.Close SaveChanges:=False
Next ws
Application.ScreenUpdating = True
End Sub
- pislick0
(01.11.23 19:49:39 ~ 21:18:14)
1
