Complicated (To Me) Procedure Build for Opening Files and Copying Data

R

reberryjr

Well-known Member
Joined
Mar 16, 2017
Messages
714
Office Version
  1. 365
Platform
  1. Windows
Here's the scenario. I have a main workbook, that I'll call Main for this conversation, and several other workbooks, that I'll call Client for this conversation. I anticipate there being no more than 100 Client workbooks in total.

What I want to do is, be able to click a cmd button in the Main workbook and have it open each of the Client workbooks, and then update the Main workbook with various data elements from each Client workbook. I know how to open a single workbook, but I have no idea on the best method to open a workbook, get the data, close the workbook, then open the next workbook...repeating the process until all Client workbooks have been opened, data pulled, and closed.

If it helps at all, I have the Client workbook names (minus the file extension) in a column in the Main workbook.
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Sort by date Sort by votes
Hi reberryjr. Here's some code to get U started. It loops through all files in a folder, opens them, loops through all the sheets in each wb to find sheet1 then copies A1:A20 to the open workbook sheet1 starting in A1, then B1 etc. It then closes the wb. U can make some adjustments to do whatever. The basic outline is there. Untested code. Looks like it should work. Just make sure your folder path is correct. Comment out the on error code to diagnose problems. HTH. Dave
Code: 
Sub Test()
Dim Lastrow As Double, sht As Worksheet, Cnt As Double, FSO As Object
Dim FlDr As Object, Fl As Object, FileNm As Object
Set FSO = CreateObject("scripting.filesystemobject")
'***change Folder path/name to your folder path/name
Set FlDr = FSO.GetFolder("YOUR FOLDER PATH AND NAME")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each Fl In FlDr.Files
If Fl.Name Like "*.xls*" Then
Workbooks.Open Filename:=FileNm
For Each sht In Workbooks(FileNm.Name).Sheets
If sht.Name = "Sheet1" Then
Cnt = Cnt + 1
Sheets(sht.Name).Range("A1:A20").Copy _
    Destination:=ThisWorkbook.Sheets("sheet1").Cells(1, Cnt)
Application.CutCopyMode = False
Exit For
End If
Next sht
Workbooks(FileNm.Name).Close SaveChanges:=False
End If
Next Fl
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set FlDr = Nothing
Set FSO = Nothing
Exit Sub
Erfix:
On Error GoTo 0
MsgBox "Error"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set FlDr = Nothing
Set FSO = Nothing
End Sub
ps. A couple of things I should also mention. If U only want to paste values and not formulas U need to adjust the copy paste code. Also, if there are merged cells in the copy paste area, the code will require some adjustments.
 
Upvote 0
@NdNoviceHlp thank you for this! For the most part, it makes sense to me. I'm almost to the point where I'm ready to start coding for this, so I may have some questions soon.
 
Upvote 0
@NdNoviceHlp I've started working on this portion now, and have a question. I'm going to have roughly 80 cells that I'm going to want to copy from each sheet, and paste into the other worksheet. I've got this code, but in leveraging yours, I'm not sure on how I would direct it to paste to a particular cell.

For example, if I want the value of E7 to map to range I and the Last Row+1, how would I code that? I know how to code for Last Row, but I hadn't seen this before:
Code: 
Destination:=ThisWorkbook.Sheets("sheet1").Cells(1, Cnt)

Here's what I have so far...
Code: 
Sub MoveCSData()

Dim ws, tsws3 As Worksheet
Dim Cnt As Double
Dim FSO, FlDr, Fl, FlName As Object
Dim tsLastRow3 As Long


Set FSO = CreateObject("Scripting.FileSystemObject")


Set FlDr = FSO.GetFolder("C:\Users\Rodger\Desktop\Bodies by Trish\Client Sheets")
Application.ScreenUpdating = False
Application.DisplayAlerts = False


For Each Fl In FlDr.Files
    If Fl.Name Like "*xlsm" Then
        Workbooks.Open FileName:=FlName
    For Each ws.Name In Workbooks(FlName.Name).Sheets
        If ws.Name = "Bio" Then
            Cnt = Cnt + 1
            Sheets(sht.Name).Range("E7").Copy
            
        




Next Fl
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set FlDr = Nothing
Set FSO = Nothing
Exit Sub
Erfix:
On Error GoTo 0
MsgBox "Error"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set FlDr = Nothing
Set FSO = Nothing
End Sub
 
Upvote 0
Not quite clear what U mean? Do U want to copy E7:E & lastrow to the wb or have E7 in your wb dictate what range to copy? As for the following...
Code: 
Destination:=ThisWorkbook.Sheets("sheet1").Cells(1, Cnt)
The cnt was used so that multiple wbs could be pasted in separate columns (Cells can use letters or numbers for column designations). Dave
 
Upvote 0
I appreciate the assistance! I wound up going a different route, because of all of the copying and pasting that I have to do. Here's what I used:

Code: 
Sub ImportWorksheets()

Dim sFile, FolderPath As String          'file to process
Dim tsws3 As Worksheet     'Bios sheet in trainer wkbk
Dim ts, cs As Workbook     'client wkbk
Dim csws3 As Worksheet     'Bio sheet in client wkbk
Dim rowTarget As Long         'output row
Dim tsLastRow3 As Long
FolderPath = "C:\Users\Rodger\Desktop\Bodies by Trish\Client Sheets\"


ThisWorkbookName = ActiveWorkbook.Name


'Throws an error if the folder doesn't exist.
If Not FileFolderExists(FolderPath) Then
   MsgBox "Specified folder does not exist, exiting!"
   Exit Sub
End If


'Resets application settings in event of an error.
On Error GoTo errHandler
Application.ScreenUpdating = False


'Sets up the target worksheet
Windows(ThisWorkbookName).Activate
Set tsws3 = ThisWorkbook.Sheets("Summaries")
  
'loop through the Excel files in the folder
sFile = Dir(FolderPath & "*.xlsm*")
Do Until sFile = ""
   
'Open the source file and set the source worksheet - ASSUMED WORKSHEET(1)
Set cs = Workbooks.Open(FolderPath & sFile)
Set csws3 = cs.Sheets("Summary") 'EDIT IF NECESSARY
tsLastRow3 = tsws3.Range("C" & Rows.Count).End(xlUp).Row
With tsws3
   .Range("A" & tsLastRow3 + 1).Value = "=Today()"
   .Range("B" & tsLastRow3 + 1).Value = csws3.Range("B3").Value
   .Range("C" & tsLastRow3 + 1).Value = csws3.Range("C3").Value
   .Range("D" & tsLastRow3 + 1).Value = csws3.Range("D3").Value
   .Range("E" & tsLastRow3 + 1).Value = csws3.Range("E3").Value
   .Range("F" & tsLastRow3 + 1).Value = csws3.Range("G3").Value
   .Range("G" & tsLastRow3 + 1).Value = csws3.Range("C7").Value
   .Range("H" & tsLastRow3 + 1).Value = csws3.Range("H3").Value
   .Range("I" & tsLastRow3 + 1).Value = csws3.Range("E7").Value
   .Range("J" & tsLastRow3 + 1).Value = csws3.Range("F7").Value
   .Range("K" & tsLastRow3 + 1).Value = csws3.Range("G7").Value
   .Range("L" & tsLastRow3 + 1).Value = csws3.Range("B11").Value
   .Range("M" & tsLastRow3 + 1).Value = csws3.Range("B12").Value
   .Range("N" & tsLastRow3 + 1).Value = csws3.Range("C11").Value
   .Range("O" & tsLastRow3 + 1).Value = csws3.Range("C12").Value
   .Range("P" & tsLastRow3 + 1).Value = csws3.Range("D11").Value
   .Range("Q" & tsLastRow3 + 1).Value = csws3.Range("D12").Value
   .Range("R" & tsLastRow3 + 1).Value = csws3.Range("E11").Value
   .Range("S" & tsLastRow3 + 1).Value = csws3.Range("E12").Value
   .Range("T" & tsLastRow3 + 1).Value = csws3.Range("F11").Value
   .Range("U" & tsLastRow3 + 1).Value = csws3.Range("F12").Value
   .Range("V" & tsLastRow3 + 1).Value = csws3.Range("G11").Value
   .Range("W" & tsLastRow3 + 1).Value = csws3.Range("G12").Value
   .Range("X" & tsLastRow3 + 1).Value = csws3.Range("H11").Value
   .Range("Y" & tsLastRow3 + 1).Value = csws3.Range("H12").Value
   .Range("Z" & tsLastRow3 + 1).Value = csws3.Range("C17").Value
   .Range("AA" & tsLastRow3 + 1).Value = csws3.Range("D17").Value
   .Range("AB" & tsLastRow3 + 1).Value = csws3.Range("C16").Value
   .Range("AC" & tsLastRow3 + 1).Value = csws3.Range("D16").Value
   .Range("AD" & tsLastRow3 + 1).Value = csws3.Range("B21").Value
   .Range("AE" & tsLastRow3 + 1).Value = csws3.Range("E21").Value
   .Range("AF" & tsLastRow3 + 1).Value = csws3.Range("B22").Value
   .Range("AG" & tsLastRow3 + 1).Value = csws3.Range("C22").Value
   .Range("AH" & tsLastRow3 + 1).Value = csws3.Range("D22").Value
   .Range("AI" & tsLastRow3 + 1).Value = csws3.Range("E22").Value
   .Range("AJ" & tsLastRow3 + 1).Value = csws3.Range("F22").Value
   .Range("AK" & tsLastRow3 + 1).Value = csws3.Range("B23").Value
   .Range("AL" & tsLastRow3 + 1).Value = csws3.Range("C23").Value
   .Range("AM" & tsLastRow3 + 1).Value = csws3.Range("D23").Value
   .Range("AN" & tsLastRow3 + 1).Value = csws3.Range("E23").Value
   .Range("AO" & tsLastRow3 + 1).Value = csws3.Range("F23").Value
   .Range("AP" & tsLastRow3 + 1).Value = csws3.Range("B24").Value
   .Range("AQ" & tsLastRow3 + 1).Value = csws3.Range("C24").Value
   .Range("AR" & tsLastRow3 + 1).Value = csws3.Range("D24").Value
   .Range("AS" & tsLastRow3 + 1).Value = csws3.Range("E24").Value
   .Range("AT" & tsLastRow3 + 1).Value = csws3.Range("F24").Value
   .Range("AU" & tsLastRow3 + 1).Value = csws3.Range("B25").Value
   .Range("AV" & tsLastRow3 + 1).Value = csws3.Range("C25").Value
   .Range("AW" & tsLastRow3 + 1).Value = csws3.Range("D25").Value
   .Range("AX" & tsLastRow3 + 1).Value = csws3.Range("E25").Value
   .Range("AY" & tsLastRow3 + 1).Value = csws3.Range("F25").Value
   .Range("AZ" & tsLastRow3 + 1).Value = csws3.Range("B26").Value
   .Range("BA" & tsLastRow3 + 1).Value = csws3.Range("C26").Value
   .Range("BB" & tsLastRow3 + 1).Value = csws3.Range("D26").Value
   .Range("BC" & tsLastRow3 + 1).Value = csws3.Range("E26").Value
   .Range("BD" & tsLastRow3 + 1).Value = csws3.Range("F26").Value
   .Range("BE" & tsLastRow3 + 1).Value = csws3.Range("B27").Value
   .Range("BF" & tsLastRow3 + 1).Value = csws3.Range("C27").Value
   .Range("BG" & tsLastRow3 + 1).Value = csws3.Range("D27").Value
   .Range("BH" & tsLastRow3 + 1).Value = csws3.Range("E27").Value
   .Range("BI" & tsLastRow3 + 1).Value = csws3.Range("F27").Value
   .Range("BJ" & tsLastRow3 + 1).Value = csws3.Range("B28").Value
   .Range("BK" & tsLastRow3 + 1).Value = csws3.Range("C28").Value
   .Range("BL" & tsLastRow3 + 1).Value = csws3.Range("D28").Value
   .Range("BM" & tsLastRow3 + 1).Value = csws3.Range("E28").Value
   .Range("BN" & tsLastRow3 + 1).Value = csws3.Range("F28").Value
   .Range("BO" & tsLastRow3 + 1).Value = csws3.Range("B29").Value
   .Range("BP" & tsLastRow3 + 1).Value = csws3.Range("C29").Value
   .Range("BQ" & tsLastRow3 + 1).Value = csws3.Range("D29").Value
   .Range("BR" & tsLastRow3 + 1).Value = csws3.Range("E29").Value
   .Range("BS" & tsLastRow3 + 1).Value = csws3.Range("F29").Value
   .Range("BT" & tsLastRow3 + 1).Value = csws3.Range("B30").Value
   .Range("BU" & tsLastRow3 + 1).Value = csws3.Range("C30").Value
   .Range("BV" & tsLastRow3 + 1).Value = csws3.Range("D30").Value
   .Range("BW" & tsLastRow3 + 1).Value = csws3.Range("E30").Value
   .Range("BX" & tsLastRow3 + 1).Value = csws3.Range("F30").Value
   .Range("BY" & tsLastRow3 + 1).Value = csws3.Range("B31").Value
   .Range("BZ" & tsLastRow3 + 1).Value = csws3.Range("C31").Value
   .Range("CA" & tsLastRow3 + 1).Value = csws3.Range("D31").Value
   .Range("CB" & tsLastRow3 + 1).Value = csws3.Range("E31").Value
   .Range("CC" & tsLastRow3 + 1).Value = csws3.Range("F31").Value
   .Range("CD" & tsLastRow3 + 1).Value = csws3.Range("B32").Value
   .Range("CE" & tsLastRow3 + 1).Value = csws3.Range("C32").Value
   .Range("CF" & tsLastRow3 + 1).Value = csws3.Range("D32").Value
   .Range("CG" & tsLastRow3 + 1).Value = csws3.Range("E32").Value
   .Range("CH" & tsLastRow3 + 1).Value = csws3.Range("F32").Value
   .Range("CI" & tsLastRow3 + 1).Value = csws3.Range("B33").Value
   .Range("CJ" & tsLastRow3 + 1).Value = csws3.Range("C33").Value
   .Range("CK" & tsLastRow3 + 1).Value = csws3.Range("D33").Value
   .Range("CK" & tsLastRow3 + 1).Value = csws3.Range("E33").Value
   .Range("CL" & tsLastRow3 + 1).Value = csws3.Range("F33").Value
End With


'close the source workbook, increment the output row and get the next file
cs.Close SaveChanges:=False
'rowTarget = rowTarget + 1
sFile = Dir()
Loop


errHandler:
On Error Resume Next
Application.ScreenUpdating = True


'tidy up
Set csws3 = Nothing
Set cs = Nothing
Set tsws3 = Nothing
End Sub
 
Upvote 0
I like that much better. I hate copy and pasting... the code is just easier to write for an uncertain outcome. The clipboard is unstable and will eventually overfill and crash with repetitive use. Just a word of caution on using DIR. I spent many frustrating hours trying to get info from a file using DIR only to find that for whatever reason DIR was skipping it and would not access it. I resolved the problem by using the file system object and I resolved to stop using DIR. You are welcome. Thanks for pasting your outcome. Dave
 
Upvote 0
You must log in or register to reply here.

Similar threads

Y
  • Question Question
Pivot Table deletes on opening of workbook
Replies
3
Views
258
cooleomter
C
A
  • Question Question
Open, Copy data and Close a workbook based on the names of the tabs in my active workbook
Replies
2
Views
137
Aurore87
A
P
  • Solved
VLOOKUP (or VBA Alternative?) From another workbook, depending on Financial Year
Replies
2
Views
494
paun_shotts
P
K
  • Solved
Code to search job id from multiple sources and update main spreadsheet.
2
Replies
10
Views
681
mumps
mumps
S
  • Question Question
Is there a way to open a workbook, refresh everything and close after success.
Replies
1
Views
851
severynm
severynm

Forum statistics

Threads
1,224,828
Messages
6,181,214
Members
453,024
Latest member
Wingit77

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top