如何匹配数据后生成新的表格

宝珠茉莉

希望能够实现打开后有一按钮，点击后将每个人所预定的水果单独建立成一个表，与总表放在一个文件夹内。跪求各位大大指导

liujialin0o0

附件啥内容都没有

宝珠茉莉

liujialin0o0 发表于 2018-9-6 09:10
附件啥内容都没有

抱歉，初次发帖。麻烦重新帮我看一下

liujialin0o0

宝珠茉莉 发表于 2018-9-6 09:21
抱歉，初次发帖。麻烦重新帮我看一下

1. Sub tt()
   
2. 
   
3. n = Cells(2, Columns.Count).End(1).Column
   
4. m = Cells(Rows.Count, 1).End(3).Row
   
5. 
   
6. Set arr = Range(Cells(2, 2), Cells(2, n))
   
7. 
   
8. For Each Rng In arr
   
9.     Worksheets.Add , Worksheets(1)
   
10.     ActiveSheet.Name = Rng.Value
    
11.     Cells(2, 1) = "水果名称"
    
12.     j = 3
    
13.     Worksheets(1).Activate
    
14.     For i = 1 To m - 2
    
15.         If Rng.Offset(i, 0).Value <> "" Then
    
16.             Cells(i + 2, 1).Copy Sheets(Rng.Value).Cells(j, 1)
    
17.             j = j + 1
    
18.         End If
    
19.     Next
    
20. Next
    
21. 
    
22. End Sub

复制代码

宝珠茉莉

liujialin0o0 发表于 2018-9-6 11:14

你好，想请教一下，如果我的总表第一列为序号，第二列为水果名称，请问这个情况代码要如何调整？
有时间的话烦请再指导一下，谢谢

liujialin0o0

宝珠茉莉 发表于 2018-9-7 10:54
你好，想请教一下，如果我的总表第一列为序号，第二列为水果名称，请问这个情况代码要如何调整？
有时间 ...

Sub tt()

n = Cells(2, Columns.Count).End(1).Column
m = Cells(Rows.Count, 1).End(3).Row

Set arr = Range(Cells(2, 3), Cells(2, n))

For Each Rng In arr
    Worksheets.Add , Worksheets(1)
    ActiveSheet.Name = Rng.Value
    ActiveSheet.Cells(2, 1) = "序号"
    ActiveSheet.Cells(2, 2) = "水果名称"
    j = 3
    Worksheets(1).Activate
    For i = 1 To m - 2
        If Rng.Offset(i, 0).Value <> "" Then
            Cells(i + 2, 1).Resize(1, 2).Copy Sheets(Rng.Value).Cells(j, 1)
            j = j + 1
        End If
    Next
Next

End Sub