Excel中VBA相关工作簿操作

VBA拆分工作簿

Sub 拆分到工作簿()
Dim wk As Workbook, ss$, k%
Application.DisplayAlerts = False
For Each sht In Workbooks("2-11.工作簿综合运用(拆分工作簿)").Sheets
    Set wk = Workbooks.Add
    k = k + 1
    Workbooks(1).Sheets(k).Copy Workbooks(2).Sheets(1)
    ss = ThisWorkbook.Path & "\" & sht.Name & ".xlsx"
    wk.SaveAs ss
    wk.Close
Next
Application.DisplayAlerts = True
MsgBox "拆分工作簿完成！"
End Sub

VBA操作EXCEl工作簿多表合并

Sub 多表合并()
Dim i%, rs%, rss%, st As Worksheet, zst As Worksheet
Set zst = Sheets("1季度") '将汇总工作表"1季度"定义为变量zst
For i = 1 To 3
    Set st = Sheets(i & "月") '将1-3每月的工作表定义为变量st
    rs = st.UsedRange.Rows.Count ' 计算1-3月份每个表的最后一行
    rss = zst.UsedRange.Rows.Count + 1 '计算“1季度的最后一行的下一行”
    st.Range("a2:b" & rs).Copy zst.Cells(rss, 1) '复制1-3表的数据到总表中
    zst.Cells(rss, 3).Resize(rs - 1) = i & "月" '将1-3表的工作表名写入到总表对应的记录中
Next
End Sub

VBA操作Excel多表拆分：

Sub 多表拆分()
  For f = 1 To 3 '循环三次（只拆分三个月）
        Worksheets.Add.Name = f & "月" '新建工作表，并以月份命名
        For Each Rng In Sheets("总表").Range("a2:a15")
            If Rng.Value = f & "月" Then '如果a列的值等于当前的月份
               n = "a" & Rng.Row & ":d" & Rng.Row '构造被复制的源表区域
               y = y + 1 '新表行数累计
               If y = 1 Then
               Sheets("总表").Range("a1:d1").Copy Sheets(f & "月").Cells(y, 1)
               End If
               Sheets("总表").Range(n).Copy Sheets(f & "月").Cells(y + 1, 1) '则将当前月份所在行复制到新建月份表中
            End If
        Next
        y = 0 '分表行数累计归零
  Next
End Sub