Wednesday, April 04, 2012

excel VBA :自動匯入各班資料

Sub 巨集2()
'
' 巨集2 巨集
'

'
 
     Dim AllFiles As String
 

     For j = 1 To 11
 
     Workbooks.Open "C:\Users\user\Desktop\定期考查得獎名單\1\1" & Format(j, "00") & ".xls"
 
     AllFiles = "1" & Format(j, "00") & ".xls"
    
    Range("A2").Select
    Windows(AllFiles).Activate
    Range("A2:D11").Select
    Selection.Copy
    Windows("total.xls").Activate
    ActiveSheet.Paste
    Range("A2").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
   
           
     Next


End Sub

No comments: