nnsea 发表于 2023-10-26 22:40:53

多表拆分VBA


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
页: [1]
查看完整版本: 多表拆分VBA