justintoolbox

請教各位先進~
目前有兩個SHEET
想要把每日的資料複製至 日累積報表
[每日資料]

[日累積]

由於目前 ...
Changbanana 發表於 2017-1-18 11:42

試試看,看看能否幫得上忙.:)

1. Sub EX()
   
2. Dim Rng, Dr
   
3. Dim i As Integer
   
4. Dim a
   
5. 
   
6. With ThisWorkbook.Worksheets("日檢核")
   
7.    Rng = .[a1].CurrentRegion.Offset(1)
   
8.    ReDim Dr(UBound(Rng) - 1, 1)
   
9.    For i = 1 To UBound(Dr)
   
10.         Dr(i, 1) = .[J2]
    
11.    Next i
    
12.    a = MsgBox("需要刪除當日檢核?", vbInformation + vbYesNo, "詢問")
    
13.     If a = vbYes Then
    
14.         .[a1].CurrentRegion.Offset(1).ClearContents
    
15.     End If
    
16. End With
    
17. With ThisWorkbook.Worksheets("日累積")
    
18.     .[A65535].End(xlUp).Offset(1).Resize(UBound(Dr), 1).Value = Dr
    
19.     .[B65535].End(xlUp).Offset(1).Resize(UBound(Rng), UBound(Rng, 2)).Value = Rng
    
20. End With
    
21. 
    
22. End Sub

複製代碼