[Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Creating Separate sheet - VBA

Posted on 2012-08-24
13
Medium Priority
?
740 Views
Last Modified: 2013-06-16
Hi Experts,

i have little problem with excel macro, I have workbook name "master" in which i have 52 sheets, if i select all sheets & then do some process (which is happen with all sheets) .the one sheet which mi working process is perfect but in rest sheets data is not properly processed which i desire. Just look in to steps which i want do with data all sheet data.

Step 1   Copy cell A2 & B2 & fill down till data in column C


Step 2  Move Or Copy - Create a copy - new book

Step 3 save new book in name of sheet (excel version 97 - 2003) & same for whole 52 sheet (save differently i.e. individual workbook) like sheet4.xls , sheet5.xls , sheet6.xls & so on


i am attaching "Master" workbook & result workbook
in sheet you will see what i want it.

so there is any macro to minimize this lengthy process.

pls help me out

Thank You
Master.xlsm
NZ1-Index.xls
0
Comment
Question by:itjockey79
  • 6
  • 6
12 Comments
 

Author Comment

by:itjockey79
ID: 38328265
i have one code but that do some different process then this but pretty much similar,


Option Explicit

Public Sub Q_27753012()
    Dim wkbMaster As Workbook
    Dim wks As Worksheet
    Dim wkb As Workbook
    Dim rng As Range
    Const cPath As String = "C:\users\mark\downloads\"
    Set wkbMaster = Application.Workbooks("Master.xls") 'assume this is already open
    Application.ScreenUpdating = False
    For Each wks In wkbMaster.Worksheets
        Set wkb = Application.Workbooks.Add
        wkb.Worksheets(1).Name = wks.Name
        wks.Range("A1").CurrentRegion.Copy wkb.Worksheets(1).Range("A1")
        Set rng = wkb.Worksheets(1).Range("A2")
        Set rng = wkb.Worksheets(1).Range(rng, wkb.Worksheets(1).Cells(rng.CurrentRegion.Rows.Count, 1))
        rng.FillDown
        Set rng = wkb.Worksheets(1).Range("G2")
        Set rng = wkb.Worksheets(1).Range(rng, wkb.Worksheets(1).Cells(rng.CurrentRegion.Rows.Count, 7))
        rng.FillDown
        rng.Value = rng.Value
        wkb.Worksheets(1).Range("I:J").EntireColumn.Delete
        wkb.SaveAs cPath & wkb.Worksheets(1).Name, 56        '56 = xlExcel8
        wkb.Close
    Next
    wkbMaster.Close
    Application.ScreenUpdating = True
End Sub

Open in new window

0
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 38328379
Sub fillNMovShts()
Dim ws As Worksheet
Dim fpath As String
fpath = "D:\temp\"
For Each ws In ThisWorkbook.Worksheets
ws.Select
Range("A2:B2").Copy Range("A2:A" & Range("C" & Rows.Count).End(xlUp).Row)
If ThisWorkbook.Worksheets.Count > 1 Then
ws.Move
ActiveWorkbook.SaveAs fpath & ActiveSheet.Name & ".xlsx"
ActiveWorkbook.Close
Else
ThisWorkbook.SaveAs fpath & ActiveSheet.Name & ".xlsx", xlExcel8
End If
Next ws
End Sub

Open in new window

0
 

Author Comment

by:itjockey79
ID: 38328461
Code working perfect Sir but i want it .xls not .xlxs extension....pls little modification
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 38328567
Change the lines...(I have not tested it)

ActiveWorkbook.SaveAs fpath & ActiveSheet.Name & ".xlsx"
ThisWorkbook.SaveAs fpath & ActiveSheet.Name & ".xlsx", xlExcel8

to

ActiveWorkbook.SaveAs fpath & ActiveSheet.Name & ".xls"
ThisWorkbook.SaveAs fpath & ActiveSheet.Name & ".xls"
0
 

Author Comment

by:itjockey79
ID: 38328593
not working Sir...
0
 
LVL 43

Assisted Solution

by:Saqib Husain, Syed
Saqib Husain, Syed earned 2000 total points
ID: 38328655
I wonder why. Here is the tested code.

Sub fillNMovShts()
Dim ws As Worksheet
Dim fpath As String
fpath = "D:\temp\"
For Each ws In ThisWorkbook.Worksheets
ws.Select
Range("A2:B2").Copy Range("A2:A" & Range("C" & Rows.Count).End(xlUp).Row)
If ThisWorkbook.Worksheets.Count > 1 Then
ws.Move
ActiveWorkbook.SaveAs fpath & ActiveSheet.Name & ".xls"
ActiveWorkbook.Close
Else
ThisWorkbook.SaveAs fpath & ActiveSheet.Name & ".xls"
End If
Next ws
End Sub

Open in new window

0
 

Accepted Solution

by:
itjockey79 earned 0 total points
ID: 38328874
Option Explicit

Public Sub Q_27753012()
    Dim wkbMaster As Workbook
    Dim wks As Worksheet
    Dim wkb As Workbook
    Dim rng As Range
    Const cPath As String = "C:\Users\Administrator\Desktop\Data\"
    Set wkbMaster = Application.Workbooks("Master.xls") 'assume this is already open
    Application.ScreenUpdating = False
    For Each wks In wkbMaster.Worksheets
        Set wkb = Application.Workbooks.Add
        wkb.Worksheets(1).Name = wks.Name
        wks.Range("A1:B1").CurrentRegion.Copy wkb.Worksheets(1).Range("A1:B1")
        Set rng = wkb.Worksheets(1).Range("A2:B2")
        Set rng = wkb.Worksheets(1).Range(rng, wkb.Worksheets(1).Cells(rng.CurrentRegion.Rows.Count, 1))
        rng.FillDown
        wkb.SaveAs cPath & wkb.Worksheets(1).Name, 56        '56 = xlExcel8
        wkb.Close
    Next
    wkbMaster.Close
    Application.ScreenUpdating = True
End Sub
0
 

Author Comment

by:itjockey79
ID: 38328877
This is working Fine.....
0
 

Author Comment

by:itjockey79
ID: 38331199
I've requested that this question be closed as follows:

Accepted answer: 0 points for itjockey79's comment http:#a38328874
Assisted answer: 500 points for ssaqibh's comment http:#a38328655

for the following reason:

As code by expert is use full but after i had click on result file one pop up message come from MS &amp; i have to click yes, this files are use for convert this excel data to chart data for my software so in converting process error message came for all file so i had change my provided code with little some from expert &amp; it &nbsp;had worked...<br /><br /><br />Thank you Expert
0
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 38331200
If you want to accept your own answer then you should provide the solution that you used to complete the question.
0
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 38331212
Sorry, I did not realize that you had provided your solution. You can go ahead and close the question as you intended to.

Saqib
0
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 38331230
BTW if you add the

,56

to the end of both the saveas statements then my program will also work as expected.
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Microsoft's Excel has many features that most people will never need nor take advantage of.  Conditional formatting is one feature that you may find a necessity once you start using it.
Windows Explorer lets you open cabinet (cab) files like any other folder. In VBA you can easily handle normal files and folders, but opening and indeed creating cabinet files takes a lot more - and that's you'll find here.
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

868 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question