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

x
?
Solved

VBA code to copy Excel Worksheets to single Worksheet, and then save to new Excel file.

Posted on 2012-09-19
3
Medium Priority
?
1,014 Views
Last Modified: 2013-02-27
I need to copy Excel Worksheets to a single Worksheet, and then save the new Worksheet as it's own file - without the VBA code in place.  I have written the following code, but it has two errors that I can easily see.  First, it loops - the Excel file never allows closure.  Second, the single Worksheet file contains no data.  The file is attached, and the code is as follows:

Private Sub Workbook_BeforeClose(Cancel As Boolean)

  Dim ws As Worksheet
  Dim r As Long
 
  Application.ScreenUpdating = False
 
  'Delete contents of Master sheet - row 2 downwards (clear from the previous Save action)
  Worksheets("MASTER").Activate
 
  With ActiveSheet.UsedRange
  .Offset(1, 0).Resize(.Rows.Count - 1).Select
  End With
 
  'Loop through all Worksheets
  For Each ws In ActiveWorkbook.Worksheets
      If ws.Name <> ActiveSheet.Name And ws.Name <> "Data" Then
      'Copy starting at 2nd Row
      ws.UsedRange.Offset(2, 0).Copy
      'Paste data to Master Worksheet, below last used row
      Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1).PasteSpecial xlPasteValues
    End If
  Next ws
 
  'Remove any blank rows
  For r = ActiveSheet.UsedRange.Rows.Count To 2 Step -1
    If Application.WorksheetFunction.CountA(Rows(r)) = 0 Then
      Rows(r).Delete
    End If
  Next r
 
  Application.DisplayAlerts = False
 
  'Write Worksheet to external file - do not include any VBA Code or Macros
  Range("A1").Select
  ActiveWorkbook.Save
      Sheets("Master").Select
    Range("A1:R1245").Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ChDir "Y:\Projects"
    ActiveWorkbook.SaveAs Filename:= _
        "Y:\Projects\data.xls", FileFormat:= _
        xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
 
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
 
End Sub
ProjectSchedule.xlsm
0
Comment
Question by:fselliott
  • 2
3 Comments
 
LVL 24

Expert Comment

by:Steve
ID: 38417426
you use a lot of Activesheet to refer to the MASTER sheet.

I would suggest changing:
Worksheets("MASTER").Activate

Open in new window

to:
dim Master as worksheet
set Master = Thisworkbook.Sheets("MASTER")

Open in new window


Then use Master. in place of Activesheet as this is far less volatile

to copy the MASTER sheet to a new workbook... just use Master.copy
this will automatically create a new active workbook with just Master as a sheet.
then can name activeworkbook and save it.
0
 

Author Comment

by:fselliott
ID: 38418033
So my code now receives an error on MASTER.Paste, and this is what is looks like (BTW, I am very unfamiliar with VBA so I can only hope I followed your instructions well):


Private Sub Workbook_BeforeClose(Cancel As Boolean)

  Dim ws As Worksheet
  Dim r As Long
  Dim MASTER As Worksheet
  Set MASTER = ThisWorkbook.Sheets("MASTER")
 
  Application.ScreenUpdating = False
 
  'Delete contents of Master sheet - row 2 downwards (clear from the previous Save action)
  Worksheets("MASTER").Activate
 
  With MASTER.UsedRange
  .Offset(1, 0).Resize(.Rows.Count - 1).Select
  End With
 
  'Loop through all Worksheets
  For Each ws In ActiveWorkbook.Worksheets
      If ws.Name <> MASTER.Name And ws.Name <> "Data" Then
      'Copy starting at 2nd Row
      ws.UsedRange.Offset(2, 0).Copy
      'Paste data to Master Worksheet, below last used row
      Cells(MASTER.UsedRange.Rows.Count + 1, 1).PasteSpecial xlPasteValues
    End If
  Next ws
 
  'Remove any blank rows
  For r = MASTER.UsedRange.Rows.Count To 2 Step -1
    If Application.WorksheetFunction.CountA(Rows(r)) = 0 Then
      Rows(r).Delete
    End If
  Next r
 
  Application.DisplayAlerts = False
 
  'Write Worksheet to external file - do not include any VBA Code or Macros
  Range("A1").Select
  ActiveWorkbook.Save
     
    MASTER.Copy
    Workbooks.Add
    MASTER.Paste
    Application.CutCopyMode = False
    ChDir "Y:\Projects"
    ActiveWorkbook.SaveAs Filename:= _
        "Y:\Projects\data.xls", FileFormat:= _
        xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
 
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
 
End Sub
0
 
LVL 24

Accepted Solution

by:
Steve earned 2000 total points
ID: 38418040
No need for Paste... Master.copy will do it all in one line.

MASTER.Copy
    ChDir "Y:\Projects"
    ActiveWorkbook.SaveAs Filename:= _
        "Y:\Projects\data.xls", FileFormat:= _
        xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False

Open in new window

0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
After seeing numerous questions for Dynamic Data Validation I notice that most have used Visual Basic to solve the problem. This suggestion is purely formula based and can be used in multiple rows.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

872 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