Hsieh

回復 6# 棋語鳥鳴

1. Sub 圓角矩形2_Click()
   
2. Dim Ar()
   
3. With Sheet1
   
4. Rng = .[Q1:T1].Value
   
5. For Each a In .Range("A2:A12")
   
6. .[Q2] = a
   
7. ReDim Preserve Ar(s)
   
8. Ar(s) = Application.Transpose(Application.Transpose(.[Q2:T2]))
   
9. s = s + 1
   
10. Next
    
11. End With
    
12. For Each sh In Sheets
    
13.   If sh.Name Like Format(Date, "yyyymmdd") & "*" Then k = k + 1
    
14. Next
    
15. k = IIf(k = 0, "", "_" & CStr(k))
    
16. With Sheets.Add
    
17. .Name = Format(Date, "yyyymmdd" & k)
    
18. .[A1:D1].Value = Rng
    
19. .[A2].Resize(s, 4) = Application.Transpose(Application.Transpose(Ar))
    
20. End With
    
21. End Sub

複製代碼