Recently I made a small demo to automatically copy the Excel account data of each sales to the Excel account of the supervisor. The main code is as follows:
-------------------------------------------------------------
Sub copyfromsubfiles ()
Dim myfile as string
Dim Arr (1000) as string 'can process up to 1000 subaccounts
Dim count as integer
Dim currentpath as string
Dim myworkbook as workbook 'parent account
Dim targetkbook as workbook subaccount
Dim startline1 as integer
Dim startline2 as integer
Currentpath = thisworkbook. Path & "\ temp \"
Myfile = Dir (currentpath &"*.*")
Count = count + 1
Arr (count) = myfile
Do While myfile <> ""
Myfile = dir
If myfile = "" then
Exit do
End if
Count = count + 1
Arr (count) = myfile 'stores the file name in the array.
Loop
'No subaccount
If count <= 0 then
Exit sub
End if
'Create a new worksheet in the parent account.
Worksheets. Add after: = worksheets (worksheets. Count)
Sheets (1). Select
Sheets (1). Rows (""). Select
Selection. Copy
Sheets (worksheets. Count). Select
Sheets (worksheets. Count). Rows ("1:1"). Select
'Application. cutcopymode = false' disable clipboard prompt information
Activesheet. Paste
Dim N as integer
N = baseline
Startline1 = n' the starting line for the parent account to Start copying
'Open each subaccount and copy the information to the parent account
For I = 1 to count
Workbooks. Open filename: = currentpath & Arr (I) 'Open the Excel file cyclically
Sheets (1). Select
N = baseline
'Start from the third line and find the end line of the subaccount Information
With sheets (1)
Do while. cells (n, 1). Text <> ""
N = n + 1
Loop
End
Startline2 = n-1 'subaccount copy end line
'Copy from the starting row
Sheets (1). Rows (baseline & ":" & startline2). Select
Selection. Copy
Thisworkbook. Activate
Sheets (worksheets. Count). Select
Sheets (worksheets. Count). Rows (startline1 & ":" & startline1). Select
Activesheet. Paste
Startline1 = startline1 + startline2-Baseline
Application. cutcopymode = false' disable clipboard prompt information
Workbooks (ARR (I). Close savechanges = false' close the subaccount
Next
'Activeworkbook. Close savechanges = false' close the opened file
Thisworkbook. Activate
Sheets (worksheets. Count). Select
Activesheet. Range ("A: AA"). entirecolumn. autofit
Activesheet. Range ("A1"). Select
'Cells. entirecolumn. autofit
Application. cutcopymode = true
End sub
----------------------------------------------------------------
Related links:
Excel VBA-Traverse files and folders in a folder and create TXT files in batches
Http://blog.csdn.net/alexbnlee/article/details/6932339
How to obtain the path of the current Excel File Using VBA
Http://blog.sina.com.cn/s/blog_611f50100100w5x7.html