[Help] How to import data from multiple unopened Excel files

Source: Internet
Author: User
Can you write a VBA program in the "Import Data" button to import the data in the yellow marked cells of the queues in the folder into the cells marked by the color of the corresponding team in the summary table? Thank you! See the attachment.
Attachment: You need to log on to download or view the attachment. No account? Register Sub YY ()
Dim s as worksheet, p $, F $,
Set S = activesheet
P = thisworkbook. Path &"/"
F = Dir (P & "*. xls ")
On Error resume next
Application. screenupdating = false
Do while F <> ""
If F <> thisworkbook. name then
Workbooks. Open P & F
A = activesheet. [i7: i36]. Value
S. cells (7, Val (f) * 14 + 9). Resize (30, 1) =
End if
Workbooks (f). Close true
F = dir
Loop
Application. screenupdating = true
End sub ----------------------------------------------
Before solving your problem, you should first learn the Dir function, which can be used to return all files in a folder
Sub thisfilderallfile ()
'Multiple Excel files in the same folder as the current workbook are returned.
Dim Arr ()
'Dir [(pathname [, attributes])]
The 'dir function can return all files in a folder (excluding subfolders). If no files exist in a folder, a null value is returned.
Worksheets. Add
Myfile = Dir (thisworkbook. Path & "/*. xls", vbnormal) 'assigns the first Excel file in the folder where the workbook is located to myfile
Redim Arr (1 to 1) 'defines a one-dimensional array, which contains an element
Arr (1) = myfile
T = 1
Do While myfile <> ""
'Dir will return the first file name that matches pathname. If you want to get another file name that matches the pathname, call dir again and do not use the parameter. If no matching file exists, Dir returns a zero-length string (""). Once the return value is a zero-length string and you want to call dir again, you must specify the pathname. Otherwise, an error occurs.
Myfile = dir
T = t + 1
Redim preserve Arr (1 to T) 'Here the preserve keyword is mainly used to reserve the previous values of the array.
Arr (t) = myfile
Loop
Range ("A1: A" & T) = application. worksheetfunction. transpose (ARR) 'because the array is a one-dimensional horizontal (column) array, it needs to be transposed to the cell area, which is a way to quickly pass values to the cell area of the array.
End sub
Sub Summary ()
'Multiple Excel files in the same folder as the current workbook are returned.
Dim Arr ()
Dim mystring as string
Application. screenupdating = false
Mystring = activeworkbook. Name
P = thisworkbook. Path
Myfile = Dir (thisworkbook. Path & "/*. xls", vbnormal)
T = 1
Do While myfile <> ""
If myfile = "" Then exit do 'When dir returns a null value, it indicates that all Excel files in the folder have been cyclically completed and the loop should be exited; otherwise, an error will occur when opening
If myfile <> mystring then
M = m + 1
Workbooks. Open filename: = P & "/" & myfile' open the workbook one by one
A = activesheet. [i7: i36]. Value
Sheet1.cells (7, 23 + 14 * (m-1). Resize (30, 1) = A' observe the relationship among columns such as 1, 2, and 3.
Activeworkbook. Close savechanges: = false
End if
Myfile = dir
Loop
Application. screenupdating = true
End sub

 

 

----------------------------------------------

In the summary table, I set the = sum (W9: W10) formula for the W8 cell, and the = sum (W14: w16) formula for the W13 cell, in cells W22, The = sum (W23: w25) formula is set. For other ak8/ak13/ak22/ay8/ay13/ay22 cells, the formula is the same, if you run the moderator program, the formula of these cells will be overwritten.

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.