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

[reberryjr]

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.

 

[NdNoviceHlp]

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

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.

 

[reberryjr]

@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.

 

[reberryjr]

@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:

Destination:=ThisWorkbook.Sheets("sheet1").Cells(1, Cnt)

Here's what I have so far...

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

 

[NdNoviceHlp]

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...

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

 

[reberryjr]

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:

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

 

[NdNoviceHlp]

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