嗯，代码不同，方法类似。[12]

顺便分享一下代码，欢迎拍砖：
Sub 按钮1_Click()
    Dim i As Variant
    Dim aa As Variant
    Dim bb As Variant
    Dim flag As Byte
   
    i = 2
    Do Until Range("F" & i).Value = ""
        i = i + 1
    Loop
    i = i - 1
   
    Rows("2:" & i).Select
    ActiveWorkbook.Worksheets("汇总表").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("汇总表").Sort.SortFields.Add Key:=Range("F2:F" & i) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("汇总表").Sort
        .SetRange Range("A2:w" & i)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    aa = "[汇总表.xlsm]汇总表!"
    bb = "[调查表.xls]2016!"
    flag = 0
    j = 15
    i = 2
    Do Until Range(aa & "F" & i).Value = ""
        If flag = 0 Then
            Workbooks.Open Filename:=ThisWorkbook.Path & "\调查表.xls"
            Range(bb & "D6").Value = Range(aa & "E" & i).Value      '纳税人名称
            Range(bb & "H6").Value = Range(aa & "F" & i).Value      '纳税人识别号
            Range(bb & "D7").Value = Range(aa & "G" & i).Value      '联系人
            Range(bb & "H7").Value = Range(aa & "H" & i).Value      '联系人电话
            Range(bb & "D8").Value = Range(aa & "I" & i).Value      '主管税局
            Range(bb & "H8").Value = Range(aa & "X" & i).Value      '电子邮箱
            Range(bb & "D9:E9").Value = Range(aa & "J" & i).Text      '注册类型代码
            Range(bb & "D10:E10").Value = Range(aa & "L" & i).Text      '行业代码

            Range(bb & "D11").Value = Int(Range(aa & "N" & i).Value + 0.5)      '营业额
            Range(bb & "H11").Value = Int(Range(aa & "O" & i).Value + 0.5)      '利润
            Range(bb & "D12").Value = Int(Range(aa & "P" & i).Value + 0.5)     '应缴
            Range(bb & "H12").Value = Int(Range(aa & "Q" & i).Value + 0.5)     '实缴
            flag = 1
        End If
        '填减免数
        Range(bb & "B" & j).Value = Range(aa & "R" & i).Value
        Range(bb & "F" & j).Value = Range(aa & "T" & i).Value
        Range(bb & "G" & j).Value = Range(aa & "U" & i).Value
        Range(bb & "H" & j).Value = Range(aa & "V" & i).Value
        Range(bb & "I" & j).Value = Range(aa & "W" & i).Value
        j = j + 1
        
        If Range(aa & "F" & i).Value <> Range(aa & "F" & i + 1).Value Then
            Windows("调查表.xls").Activate
            ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Range(aa & "D" & i).Value & "\" _
                & Range(aa & "F" & i).Value & ".xls"
            ActiveWindow.Close          '关闭
            flag = 0
            j = 15
        End If
        i = i + 1
    Loop
   
End Sub

嘿嘿。。。我的方法基本相同  一秒左右一个表，2000户差不多也是三四十分钟吧

我们局这项任务目前就只需要我一个人[67]

嗯，个人觉得Excel是强大的数据处理工具，个人掌握的只是皮毛而已。

不知道你所说的半自动是怎么个概念。因为我这个也有个前提，那就是你得保证数据是准确的。然后按照要求将数据摆放相应的单元格即可。

谢谢，这个平台就是交流的平台。欢迎提出有建设性意见。[39]

没有用过小精灵，可能效果差不多吧。

[49] 比我快多了，不会VBA，靠小精灵15秒一个

不好意思，我不是高州局的哦。感谢关注。

之前测试过生成55个文档（包括匹配数据），大概1分多钟，按此计算，大概需要37分钟吧。

厉害！是我们高州的同志吗？

用VBA也要37分钟吗，VBA是不是也是用写入文件另存的方法？

[42] 呃，我这里是半自动人工

VBA原来可以向固定格式导数据啊，长见识了

其实不用那么累的。2000多份表其实也就是37分钟的事情。[32]

我地就系人工做左2000多份表啊[49]

[12] [12] [12] ,好，多些业务交流是好同志！

声明：不公开共享，如有兴趣可以私聊。一切尽在演示中，感谢大家多年的支持。
演示说明：
演示数据即为从系统导出的数据，格式与排版均为系统默认的，在此基础上，可能需要花少少时间整理（如果数据信息不完整的情况下），其他只要按演示那样即可一键批量生成。这样你就可以利用时间去忙其他的事情了。觉得是不是超级方便呢？