vba中的workbooks.add系统地打开了两个工作簿

时间:2017-06-27 07:07:24

标签: excel vba excel-vba

当我尝试在vba中打开一个新工作簿时 - 从我的个人宏工作簿中的宏开始 - 使用:

Workbooks.Add
系统地打开了两本工作簿。

当我尝试使用类似的东西:

Workbooks("book1").Activate

它很少有用,因为在" book"之后的数字索引很少与" book1"。

相匹配

我的最终目的是自动为创建的工作簿命名。

然而,vba最终命名第二个空的工作簿而不是第一个可取的工作簿。

我有Office 365 Home。

完整的代码是:

********************
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
********************

注意:我在这个论坛上经历过几十个提示,以便人们在菜单中使用Excel打开工作簿时遇到类似的问题。他们不工作。

请注意,我的问题是使用vba代码打开工作簿。

宏一直在Workbooks.Add之前工作。

然而,在那一点上,这就是:

1)它创建一个新工作簿并将初始工作簿中包含的初始工作表的内容导出到这个新工作表 - 这正是我想要的;

2)然后它打开第二个工作表 - 这不是我想要的 - 并且在命令" ActiveWorkbook.Activate",它选择了第二个不需要的工作簿,并且实际上成功地命名并保存它。

因此,我有一个成功命名并保存的文件,但它没有内容,因为第二个工作簿是空的。我想要的是命名并保存包含导出内容的第一个工作簿。

注意:当我关闭所有Excel工作簿时,当我只重新打开开始工作簿时以及当我更换行" Workbooks.Add"使用"'工作簿(" book1")。例如,激活"。

然而,由于上述原因,这并不能提供可重复的,可靠的结果。

任何帮助都将不胜感激。

3 个答案:

答案 0 :(得分:3)

如果代码中存在问题,我会看到很多。

  1. 避免使用.Activate/.Select。您可能希望查看How to avoid using Select in Excel VBA macros

  2. 使用对象。了解我如何声明工作表/范围/工作簿对象

  3. 这是你在尝试的吗?

    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
    

答案 1 :(得分: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

答案 2 :(得分:0)

但是,我找到了一个完美的解决方案,我的问题如下:

Sub ExportNameAndSave()

ActiveWindow.Activate

startingpoint = ActiveWorkbook.Name

ActiveSheet.Select

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

refnumber =范围(" b4")。值

范围(" A1",范围(" a60000")。结束(xlUp))。选择 设置lastrow =选择

范围(" A1",范围(" a1")。偏移(0,50).End(xlToLeft))。选择 设置lastcolumn =选择

范围(lastrow,lastcolumn)。选择

Selection.Copy

Workbooks.Add

Dim checkedopenworkbook As Excel.Workbook

对于每个checkedopenworkbook在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

下一页checkopenworkbook

End Sub