求助大神，分拆总表至不同分表

fhqlrwgss

论坛中找到的都是根据总表某字段自动生成新sheet，想知道如果分表本来就存在，想自动分类到分表，且截取部分字段横置排列，如何写vba？
比如下表分类a\b\c三类，sheet a类 b类 c类是本来就存在的表格，按下按钮1后根据不同分类自动分类至不同分表中，仅保留部分字段，且字段需横置，如附件

是不是这个意思

fhqlrwgss

浅饮深醉 发表于 2019-1-25 15:48
是不是这个意思

大神，能否重新上传下附件？附件打不开

fhqlrwgss

继续求助大神

nmcfbgttyl

我只是搬运工！
你说上面的附件打不开，我下载了，打开了，另存为2003格式了，你再试试，在我这里非常好用的。 好用.rar (10.14 KB, 下载次数: 1)

2019-2-5 17:14 上传

点击文件名下载附件

nmcfbgttyl

我只是搬运工！
你说上面的附件打不开，我下载了，打开了，另存为2003格式了，你再试试，在我这里非常好用的。
好用.rar (10.14 KB, 下载次数: 1)

2019-2-5 17:14 上传

点击文件名下载附件

这个

liangmutou

代码见后：
Sub caifen()
  Dim ar, h As Long, b As Worksheet
  ar = Sheet1.Range("b2:h" & Sheet1.[h65536].End(3).Row)
  For Each b In Sheets
    For h = 1 To UBound(ar)
      If b.Name = ar(h, 7) Then
        c = b.Range("aa2").End(xlToLeft).Column + 1
        b.Cells(2, c) = ar(h, 2): b.Cells(3, c) = ar(h, 1)
        b.Cells(4, c) = ar(h, 3): b.Cells(5, c) = ar(h, 4)
        b.Cells(6, c) = ar(h, 5): b.Cells(7, c) = ar(h, 6)
      End If
    Next h
  Next b
End Sub

liangmutou

把附件发给你。

liangmutou 发表于 2019-2-18 15:00
代码见后：
Sub caifen()
  Dim ar, h As Long, b As Worksheet

大神，方便留个QQ吗？有问题想单独请教。