Hsieh

回復 1# jesscc

1. Sub ContainerDetails()
   
2. Set swb = ThisWorkbook
   
3.    mypath = "C:\Documents and Settings\Administrator\桌面\"
   
4.    myfile = Format(Date, "emmdd") & "已出貨.xlsx"
   
5.    swb.Sheets(Array("AA", "BB", "CC")).Copy
   
6.    Set wb = ActiveWorkbook
   
7.    wb.Sheets("AA").Shapes.Range(Array("CommandButton6")).Delete
   
8.    wb.Sheets("AA").Range("B7:J500").ClearContents
   
9.    wb.Sheets("BB").Range("B7:J500").ClearContents
   
10.    wb.Sheets("CC").Range("B7:J500").ClearContents
    
11. 
    
12. For Each Sh In swb.Sheets(Array("AA", "BB", "CC"))
    
13. Dim Ay()
    
14. With Sh
    
15. For i = 7 To .Cells(.Rows.Count, 2).End(xlUp).Row
    
16.       If .Range("B" & i) = "v" Or .Range("B" & i) = "*" Then
    
17.       ReDim Preserve Ay(s)
    
18.       Ay(s) = .Range("B" & i).Resize(, 10).Value
    
19.       s = s + 1
    
20.       End If
    
21. Next
    
22. wb.Sheets(.Name).[B7].Resize(s, 10) = Application.Transpose(Application.Transpose(Ay))
    
23. Erase Ay
    
24. s = 0
    
25. End With
    
26. Next
    
27. wb.SaveAs mypath & myfile
    
28. End Sub

複製代碼

Hsieh

回復 3# jesscc


   if s>0 then  wb.Sheets(.Name).[B7].Resize(s, 10) = Application.Transpose(Application.Transpose(Ay))