将编号和数量复制到对应的工作表中

qaz10121

各位老师看下这个怎么能实现啊，将编号和数量复制到对应的工作表中

liulang0808

http://club.excelhome.net/thread-1385473-1-1.html
楼主可以参考下看看

garfield133

Sub sss()
    Dim i As Integer
    Dim l As Integer
    Dim k As Integer
    Let k = 2
    For l = 2 To Worksheets.Count
    For i = 1 To Application.WorksheetFunction.CountA(Range("C:C")) - 1
    If Worksheets(l).Name = Cells(2 + i, 3).Value Then
    Worksheets(l).Cells(k, 4).Value = Worksheets("总表").Cells(2 + i, 4).Value
    Worksheets(l).Cells(k, 5).Value = Worksheets("总表").Cells(2 + i, 5).Value
    k = k + 1
    End If
    Next
    Let k = 2
    Next
End Sub

wbperfect

1. Sub text()
   
2. Dim m, n As Long
   
3. 
   
4. For m = 2 To Worksheets.Count
   
5. k = Sheets(m).Cells(Rows.Count, 3).End(xlUp).Row + 1
   
6. For n = 3 To Sheets("总表").Range("C1048576").End(xlUp).Row
   
7. 
   
8. If Sheets("总表").Cells(n, 3) = Sheets(m).Name Then
   
9. 
   
10.    Sheets(m).Cells(k, 4) = Sheets("总表").Cells(n, 4)
    
11.    Sheets(m).Cells(k, 5) = Sheets("总表").Cells(n, 5)
    
12.    k = k + 1
    
13. End If
    
14. 
    
15. Next n
    
16. 
    
17. Next m
    
18. 
    
19. End Sub

复制代码

wbperfect

附件请参考~~~~~~~~~

kuangben8

很类似拆分工作表。参考如下，来源：看见星光

复制.zip (26.94 KB, 下载次数: 5)

2020-1-10 14:12 上传

点击文件名下载附件

answer6141

1. Sub test()
   
2. Dim i, j, k, l, m, r As Integer
   
3. Dim arr, brr, crr
   
4. Dim d1, d2 As Object
   
5. 
   
6. Set d1 = CreateObject("scripting.dictionary")
   
7. With Sheets("总表")
   
8.     r = .Cells(.Cells.Rows.Count, 3).End(xlUp).Row
   
9.     arr = .Range("c2:e" & r)
   
10.     For i = 3 To UBound(arr)
    
11.         d1(arr(i, 1)) = d1(arr(i, 1)) + 1
    
12.     Next
    
13.     brr = d1.keys
    
14.     Debug.Print r
    
15.     For k = 0 To UBound(brr)
    
16.         n = 1
    
17.         Debug.Print brr(k)
    
18.         For j = 3 To UBound(arr)
    
19.             If arr(j, 1) = brr(k) Then
    
20.                 n = n + 1
    
21.                 Sheets(brr(k)).Range("d" & n) = arr(j, 2)
    
22.                 Sheets(brr(k)).Range("e" & n) = arr(j, 3)
    
23.             End If
    
24.         Next
    
25.     Next
    
26.    
    
27. End With
    
28. End Sub
    
29. 供参考

复制代码