将一个excel分解成多个excel文档，自己写的代码有点问题，求教啊！
Sub 分解()
Dim H As Long, H1 As Long, M As String, K As Integer, BM As Workbook
Dim PAT As String
Application.ScreenUpdating = False
PAT = ThisWorkbook.Path & "\"
With Sheet1
Rows("1:1").Select
Selection.Delete Shift:=xlUp //第一行数据没用
H = .Range("a65536").End(xlUp).Row
For H1 = 1 To H //此处有问题，循环一次就结束了
If M = "" Then
M = Cells(H1, 1)
End If
If H1 <> H And Cells(H1, 1) <> Cells(H1 + 1, 1) Then
Range(Cells(H1 - K, 1), Cells(H1, 5)).Copy //文档共有5列
Set BM = Workbooks.Add(1)
BM.SaveAs PAT & M & ".csv" //存为csv格式
Sheets("Sheet1").Select
Sheets("Sheet1").Range("A1").Select //粘贴的代码有问题
ActiveSheet.Paste
BM.Close True
M = ""
K = 0
Else: K = K + 1
End If
Next H1
End With
Application.ScreenUpdating = True
End Sub
实现的功能就是将excel按照A列的值进行分解，A列相同的直接存储到一个新的excel表格里，新excel表以A列的值命名。数据已经按照A列排过序了。
如： 1,J1,1,3621212.23,38123456.354
1,J2,2,3645645.12,38456789.321
1,D3,3,3645685.12,38456659.324
3,Z1,1,3624562.23,38126586.354
3,D1,2,3687545.12,3844589.321
............ 最后就是要把前3行生成一个新EXCEL,并命名为1.csv，以此类推，3.csv.......
调试的时候有问题，刚接触VBA这方面，数据很多，求大大帮帮忙啊！
[解决办法]
你试试吧
Sub 分解() Dim H As Long, H1 As Long, M As String, K As Integer, BM As Workbook, OrigBook As Workbook Dim PAT As String Application.ScreenUpdating = False Application.DisplayAlerts = False Set OrigBook = ActiveWorkbook PAT = ThisWorkbook.Path & "\" With Sheet1 Rows("1:1").Select 'Selection.Delete Shift:=xlUp '第一行数据没用 H = .Range("a65536").End(xlUp).Row For H1 = 2 To H '如果第一行没有用，就从第二行开始 If M = "" Then M = Cells(H1, 1) End If If Cells(H1, 1) <> Cells(H1 + 1, 1) Then 'Range(Cells(H1 - K, 1), Cells(H1, 5)).Copy '文档共有5列 Set BM = Workbooks.Add(1) BM.SaveAs PAT & M & ".csv" '存为csv格式 Sheets("Sheet1").Select OrigBook.Sheets(1).Range(Cells(H1 - K, 1).Address, Cells(H1, 5).Address).Copy '文档共有5列 Sheets("Sheet1").Range("A1").Select '粘贴的代码有问题 ActiveSheet.Paste BM.Close True M = "" K = 0 Else: K = K + 1 End If Next H1 End With Application.DisplayAlerts = True Application.ScreenUpdating = TrueEnd Sub