2

When I try and open a new workbook in vba - from a macro based in my Personal Macro Workbook - using:

Workbooks.Add

it systematically opens two workbooks.

When I try the same using something like:

Workbooks("book1").Activate

it rarely works because the number index after the word "book" rarely matches that of "book1".

My ultimate purpose is to automatically name the created workbook.

However, vba winds up naming the second, empty workbook rather than the first, desirable one.

I have Office 365 Home.

The full code is:

********************
Sub ExportNameAndSave()

ActiveWindow.Activate
ActiveSheet.Select

Dim lastrow As Range
Dim lastcolumn As Range
Dim refnumber As String

refnumber = Range("b4").Value

Range("A1", Range("a60000").End(xlUp)).Select
Set lastrow = Selection

Range("A1", Range("a1").Offset(0, 50).End(xlToLeft)).Select
Set lastcolumn = Selection

Range(lastrow, lastcolumn).Select

Selection.Copy
Workbooks.Add

ActiveWorkbook.Activate
ActiveWorkbook.SaveAs Filename:="D:\Common Area\" & refnumber & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

End Sub
********************

Note: I have been through dozens of tips on this forum for people encountering similar problems when they open a workbook in Excel from menus. They DO NOT work.

Note that my problem is about opening a workbook using vba code.

The macro works all the way to just before Workbooks.Add.

However, at that point, this is what happens:

1) It creates a new workbook and exports the content of the intial sheet contained in the initial workbook to this new worksheet - which is exactly what I want;

2) Then it opens a second worksheet - which is NOT what I want - and at the command "ActiveWorkbook.Activate", it selects this second undesirable workbook and actually succesfully names it and saves it.

Therefore, I have a successfully named and saved file, but it is empty of content, because the second workbook is empty. What I want is to name and save the first workbook that contains the exported content.

Note: this sub works well when I close all my Excel workbooks, when I re-open only the start workbook and when I replace the line "Workbooks.Add" with "'Workbooks("book1").Activate", for example.

However, this does not give repeatable, reliable results, for the aforementioned reasons.

Any help would be appreciated.

Shai Rado
  • 33,032
  • 6
  • 29
  • 51
L H
  • 21
  • 1
  • 2
  • After reading your post I am still confused, what are you trying to achieve ? You want to copy `ActiveSheet` (which is already not reccomended) to a new workbook ? and you want to create this new workbook by code ? with this line- `Workbooks.Add` ? – Shai Rado Jun 27 '17 at 07:17
  • 3
    Quick qustion. You are copying the range but not pasting it somewhere? – Siddharth Rout Jun 27 '17 at 07:18
  • 1
    @SiddharthRout that's a good one ;) missed on that – Shai Rado Jun 27 '17 at 07:20

3 Answers3

3

I see lot if issues in your code.

  1. Avoid the use of .Activate/.Select. You may want to see How to avoid using Select in Excel VBA macros

  2. Work with objects. See how I have declared the worksheet/range/workbook objects

Is this what you are trying?

Sub ExportNameAndSave()
    Dim lRow As Long, lCol As Long
    Dim refnumber As String
    Dim ws As Worksheet
    Dim wb As Workbook

    '~~> Change this to the relevant sheet
    Set ws = ActiveSheet

    With ws
        '~~> Find last row and last column
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
        lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

        refnumber = .Range("b4").Value

        '~~> Set your range
        Set rng = .Range(.Cells(1, 1), .Cells(lRow, lCol))

        '~~> Add a new workbook
        Set wb = Workbooks.Add

        '~~> Copy the range to sheet1 of new workbook
        rng.Copy wb.Sheets(1).Range(rng.Address)
    End With

    '~~> Save the new workbook
    wb.SaveAs Filename:="D:\Common Area\" & refnumber & ".xlsm", _
              FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
              CreateBackup:=False

End Sub
Siddharth Rout
  • 147,039
  • 17
  • 206
  • 250
0
Sub ExportNameAndSave()

ActiveWindow.Activate
ActiveSheet.Select

Dim wkbk As Workbook
Dim lastrow As Range
Dim lastcolumn As Range
Dim refnumber As String

refnumber = Range("b4").Value

Range("A1", Range("a60000").End(xlUp)).Select
Set lastrow = Selection

Range("A1", Range("a1").Offset(0, 50).End(xlToLeft)).Select
Set lastcolumn = Selection

Range(lastrow, lastcolumn).Select

Selection.Copy
Set wkbkSource = Workbooks.Add

ActiveWorkbook.Activate
ActiveWorkbook.SaveAs Filename:="D:\Common Area\" & refnumber & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

End Sub
Lowpar
  • 897
  • 10
  • 31
0

However, I found a perfectly working work-around for my problem, as follows:


Sub ExportNameAndSave()

ActiveWindow.Activate

startingpoint = ActiveWorkbook.Name

ActiveSheet.Select

Dim lastrow As Range Dim lastcolumn As Range Dim refnumber As String

refnumber = Range("b4").Value

Range("A1", Range("a60000").End(xlUp)).Select Set lastrow = Selection

Range("A1", Range("a1").Offset(0, 50).End(xlToLeft)).Select Set lastcolumn = Selection

Range(lastrow, lastcolumn).Select

Selection.Copy

Workbooks.Add

Dim checkedopenworkbook As Excel.Workbook

For Each checkedopenworkbook In Excel.Workbooks

    If checkedopenworkbook.Name = "PERSONAL.XLSB" Then


        Else

        If checkedopenworkbook.Name = startingpoint Then


        Else


        checkedopenworkbook.Activate

        If ActiveSheet.Range("a1").Value = "" Then

            checkedopenworkbook.Close

        Else

            checkedopenworkbook.Activate

            checkedopenworkbook.SaveAs Filename:="D:\Common Area\" & refnumber & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False


        End If

    End If


    End If

Next checkedopenworkbook

End Sub


L H
  • 21
  • 1
  • 2