View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Martyn Martyn is offline
external usenet poster
 
Posts: 80
Default is it possible to change this macro to save each sheet seperately?

Hi,
The below macro manages to create seperate sheets to the workbook using the
A:A column data:
--------------------------
Sub SayfaYarat()
On Error Resume Next
Dim rng As Range
Dim cll As Range
Dim NewBook As Workbook
Dim cnt As Integer
Dim ShtCnt As Integer
Set rng = Range("A1", Range("A1").End(xlDown))
If IsEmpty(rng.Cells(1, 1)) Then
Exit Sub
End If
Set NewBook = ActiveWorkbook
cnt = 1
ShtCnt = ActiveWorkbook.Sheets.Count
Do
With NewBook
.Worksheets.Add after:=.Worksheets(.Worksheets.Count)
ActiveSheet.Name = rng.Cells(cnt, 1).Value
cnt = cnt + 1
End With
Loop Until NewBook.Worksheets.Count - ShtCnt = rng.Rows.Count
End Sub
-----------------------------------
Considering a workbook having lots of pages, I need to modify this macro so
that when executed it will save each sheet to C:\Samples directory as
seperate Workbooks with its sheets name (i.e.: Sheet1.xls,
Sheet2.xls....etc). Is it possible?
I'd appreciate other solution suggestions too...
TIA
Martyn