请诸位高手帮忙看看这段代码是为了实现简单的数据复制粘贴以及高级筛选，为何未达到目的。

[claider]

需要通过VBA Excel实现以下功能：
我有一段excel文件，数据包含各机构信息，内容类似如下：
机构代码 其他字段
abc100669 abc1006691000
abc100669 abc1006691007
abc100669 abc1006691008
abc988145 abc9881451000
abc988145 abc9881451003
abc988145 abc9881451004
abc988146 abc9881461000
abc988836 abc9888361003
abc988838 abc9888381000
abc988838 abc9888381001
abc988839 abc9888391002
1、根据每个机构代码生成一个文件，文件名即该机构代码，假设为NewFileOrgId，该文件中包含且仅包含以上数据中该机构信息。在本例中，即对于以上数据，生成名为abc100669.xlsx，abc988145.xlsx，abc988146.xlsx，abc988836.xlsx，abc988838.xlsx，abc988839.xlsx。

2、对于每个文件NewFileOrgId，例如abc100669.xlsx，通过对单元格赋值和复制黏贴操作，在这一步使得文件内容为：
机构代码 其他字段
abc100669
机构代码 其他字段
abc100669 abc1006691000
abc100669 abc1006691007
abc100669 abc1006691008
abc988145 abc9881451000
abc988145 abc9881451003
abc988145 abc9881451004
abc988146 abc9881461000
abc988836 abc9888361003
abc988838 abc9888381000
abc988838 abc9888381001
abc988839 abc9888391002

3、对于第2步处理过的文件进行高级筛选，即列表区域为 (A3:B14)，条件区域为(A1:B2)，经过筛选后，文件abc100669.xlsx的内容变成：
机构代码 其他字段
abc100669
机构代码 其他字段
abc100669 abc1006691000
abc100669 abc1006691007
abc100669 abc1006691008


相应地其他文件abc988145.xlsx，abc988146.xlsx，abc988836.xlsx，abc988838.xlsx，abc988839.xlsx内容各自生成类似如上的格式。
【现在碰到的麻烦】

Sub ForgeMulFilesToORGWithParameter(ORGid)
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
    Workbooks.Add
        
    Range("a1").Select
    ActiveCell.FormulaR1C1 = "机构号"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "其他字段"
        
    Range("a2").Select
    ActiveCell.FormulaR1C1 = ORGid

    Range("A3").Select
    ActiveSheet.Paste
        
    ActiveSheet.Range("A3:B78").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
    ActiveSheet.Range("A1:B2"), Unique:=False
        
    ChDir "E:\VBA\testdir"
    StrDate = Format(Date, "yyyymmdd")
    StrTime = Format(Time, "hhmmss")
    StrFilename = "E:\VBA\testdir\" & ORGid  & ".xlsx"
    ActiveWorkbook.SaveAs Filename:=StrFilename, FileFormat _
        :=xlOpenXMLWorkbook, CreateBackup:=False

    ActiveWorkbook.Save
End Sub

'用这个按钮事件过程调用以上函数对于单次调用并生成文件可以成功
Private Sub CmdBtnNewFileOrg_Click()
    Call ForgeMulFilesToORGWithParameter("abc100669")
End Sub

'用这样的方法调用，则文件abc100669.xlsx的内容可以成功，但是abc988145.xlsx文件的内容无法成功：
Private Sub CmdBtnNewFileOrg_Click()
    Call ForgeMulFilesToORGWithParameter("abc100669")
    Call ForgeMulFilesToORGWithParameter("abc988145")
End Sub

后一种调用时，生成的abc988145.xlsx文件的内容为
机构代码 其他字段
abc988145
机构代码 其他字段


请问高手为何ForgeMulFilesToORGWithParameter()过程不可以连续调用两次？有没有好的解决方法？

[一如既往哈]

来个一劳永逸的法儿：现排序然后在循环

Sub Test()
    ''这段代码放在目标表格的vba里
    Dim Sht As Worksheet, i As Long, iStart As Long, iEnd As Long, w1 As String
    Dim iLast As Long, Wbk As Workbook
    Set Sht = ActiveSheet
    With Sht
        ''对原始数据进行排序 999个数据
        .Range("a2:b1000").Sort Key1:=.Range("A2")
        ''确定最后一行
        iLast = .Range("a1").End(xlDown).Row
        ''开始逐渐创建工作簿
        For i = 2 To iLast + 1
            If w1 = "" Then
                w1 = .Range("a" & i)
                iStart = i
                If w1 = "" Then Exit For
            Else
                If w1 <> .Range("a" & i) Then
                    ''开始创建
                    Set Wbk = Application.Workbooks.Add
                    If Wbk.Worksheets.Count < 1 Then Wbk.Worksheets.Add
                    ''复制数据
                    .Range("a" & iStart & ":b" & iEnd).Copy Wbk.Worksheets(1).Range("a2")
                    ''复制标题
                    .Range("a1:b1").Copy Wbk.Worksheets(1).Range("a1")
                    ''保存并退出
                    Wbk.SaveAs "d:\" & w1 & ".xls"
                    Wbk.Close
                    Set Wbk = Nothing
                    w1 = .Range("a" & i)
                    iStart = i
                    iEnd = i
                Else
                    iEnd = i
                End If
            End If
        Next
    End With
End Sub


'

.... 这是比较基本你自己看着修改吧

[一如既往哈]

现排序然后在循环 ==》先排序然后再循环 居然有2个错别字。

[舉杯邀明月]

引用 3 楼 Topc008 的回复:

现排序然后在循环 ==》先排序然后再循环 居然有2个错别字。

你用五笔输入法，这个问题就可以避免了。

[舉杯邀明月]

怎么我这儿的运行结果，Call ForgeMulFilesToORGWithParameter("abc100669") 从第4行开始的数据都没显示，被隐藏了？ 因为我这儿的运行结果跟你的描述不一致，并且对“高级筛选”还不清楚它的具体效果， 不知道你的代码还有没有别的问题。 你的代码，之所以“不可以连续调用两次”，是因为逻辑问题： 在过程 Sub ForgeMulFilesToORGWithParameter(ORGid) 中， Range("A1").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy 这几行代码，都是针对“活动工作簿”进行的操作（因为你没有明确指定被操作的工作簿）， 你从“第二次调用”开始，活动工作簿已经不是最初的工作簿了，“数据源”错了，没有正确复制到数据。 因此，你这几行代码，都应该明确指定被操作的工作簿对象才行！

[claider]

好久没有搞这个问题了，是不是先给大伙儿结帖？

[脆皮大雪糕]

引用 4 楼 Chen8013 的回复:

[quote=引用 3 楼 Topc008 的回复:] 现排序然后在循环 ==》先排序然后再循环 居然有2个错别字。

你用五笔输入法，这个问题就可以避免了。 [/quote] 暴露年龄

[mrharong2017]

ForgeMulFilesToORGWithParameter
函数内部第一句增加
WORKBOOKS("源数据.xlsx").activate

[舉杯邀明月]

引用 7 楼 chewinggum 的回复:

[quote=引用 4 楼 Chen8013 的回复:] [quote=引用 3 楼 Topc008 的回复:] 现排序然后在循环 ==》先排序然后再循环 居然有2个错别字。

你用五笔输入法，这个问题就可以避免了。 [/quote] 暴露年龄[/quote] 这跟年龄扯得上关系？ 我所认识的，无论比我年长、还是比我年幼的， 　　除了做文职工作的人，用拼音输入法的肯定占95%以上。 所以一般情况下，用哪种输入法，跟工作性质的关系比较大，而跟年龄几乎无关。

[脆皮大雪糕]

哦 用五笔的，猜他是八五前，八九不离十 但反之基本不成立。

[claider]

哈哈哈。有一阵子我用郑码。

[赵4老师]

王旁青头戋五一……