宏在创建新工作簿后停止运行

时间:2018-05-03 21:54:49

标签: excel vba excel-vba

我有一个工作问题,我希望我的宏可以执行以下操作

我有两列(A列和B列)。列A包含名称,列B包含其信息。

我希望我的宏找到重复的名称并复制col A和B并将它们粘贴到以下位置的另一个电子表格中

C:\Users\kentan\Desktop\Managed Fund

创建的每个电子表格都必须包含该名称的名称作为文件名

我已创建宏来执行以下操作,但它没有给我正确的结果

它既没有将它放入托管资金文件夹(将它们放在桌面上)又只将其复制到另一个电子表格中

所以我的电子表格就像这样

Investment Advisor  Managed Fund
Fidelity 1          Fidelity 20
Fidelity 1          Fidelity 21
PIMCO               PIMCO 22
PIMCO               PIMCO 23
PIMCO               PIMCO 24

宏做了什么创建了一个保真度1电子表格,只放入

Fidelity 1  Fidelity 21 
而不是所有的保真基金。你能告诉我为什么吗?

Option Explicit

Public Const strSA As String = "C:\Users\tempo\Desktop\Managed Fund "

Sub iris()
Dim i As Long
With ActiveSheet
    With .Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 
1))
        .Sort key1:=.Columns(1), order1:=xlAscending, _
              key2:=.Columns(2), order2:=xlAscending, _
              Header:=xlYes, MatchCase:=False, _
              Orientation:=xlTopToBottom, SortMethod:=xlStroke
    End With

    For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).row
        If LCase(.Cells(i, "A").Value2) = LCase(.Cells(i - 1, "A").Value2) 
    And _
           LCase(.Cells(i, "A").Value2) <> LCase(.Cells(i + 1, "A").Value2) 
    Then
            newiris .Cells(i, "A").Value2, .Cells(i, "B").Value2
        End If
        Next
    End With
   End Sub

 Sub newiris(nm As String, nfo As String)
 Application.DisplayAlerts = False
With Workbooks.Add
    Do While .Worksheets.Count > 1: .Worksheets(2).Delete: Loop
    .Worksheets(1).Cells(1, "A").Resize(1, 2) = Array(nm, nfo)
    .SaveAs Filename:=strSA & nm, FileFormat:=xlOpenXMLWorkbook
    .Close savechanges:=False
End With
Application.DisplayAlerts = True
End Sub

1 个答案:

答案 0 :(得分:1)

您的问题可能是function deletelist() { localStorage.removeItem(list); } 关闭了工作簿。我不完全理解调用宏的方式,但我知道,一旦关闭工作簿,代码就会停止运行。

尝试在一个Sub中创建工作簿,然后立即关闭它们。关闭第一个工作簿后,下面的代码可能会停止运行,但至少你已经创建了每个工作簿。

Sub newiris()