open all files in a folder, copy cells, paste to new workbook, close and repeate through all woorkbooks.

[jhow659]

is it possible to open all files in a folder, have cells bj16:br16 copied and pasted to a new workbook, closed out and repeated through all workbooks in the folder?

also if this is used with a macro button and I press it again after another workbook is added could I have it only add the information from the workbook not previously add so that there isn't duplicate data on my sheet?

thanks for your help ahead of time

 

[Wookiee213]

Yes, take a look at the DIR command and use it to build an array of filenames to open within a loop, take the data then close the workbook.

 

[Wookiee213]

Yes, take a look at the DIR command and use it to build an array of filenames to open within a loop, take the data then close the workbook.

This should get you most of the way there.

Global serverID As String
Global thePath As String
Global fileArray() As String

Sub findFiles()
Dim arraySize As Double
Dim fileNamePattern As String

Let arraySize = 0 'resets
Let serverID = "" 'the "drive" you're on goes here
Let thePath = "" 'the folder path you're on goes here


Let fileNamePattern = Dir(serverID & thePath & "*") 

Do While Len(fileNamePattern) > 0 
    Let arraySize = arraySize + 1 'grows the array for each file
    ReDim Preserve fileArray(arraySize) 're size the array dynamically
    Let fileArray(arraySize) = fileNamePattern 'loads the filename into the array
    fileNamePattern = Dir
Loop 'check the next file in the folder


If arraySize = 0 Then 'just a quick check to prevent you trying to open files which don't exist
    MsgBox "No Files Found matching those criteria"
    Exit Sub
Else
    Call getData
End If


End Sub

Sub getData()
Dim fileLoop As Double
Dim dataFile As String 'name of the file you're opening
Dim NewFileName As String 'the newly generated report




Application.DisplayAlerts = False
Application.ScreenUpdating = False

Let NewFileName = "NEW FILE " & Format(Now, "ddmmyyyy") & Format(Now, "hhmmss") 'amend this to whatever name you want
Workbooks.Add
ActiveWorkbook.SaveAs serverID & thePath & NewFileName 'just saves the new workbook

For fileLoop = 1 To UBound(fileArray)
    Let dataFile = fileArray(fileLoop)
    Workbooks.Open serverID & thePath & dataFile
    Workbooks(dataFile).Worksheets(1).Range("BJ16:BR16").Copy
     Workbooks(NewFileName).Worksheets(1).Cells(fileLoop, 1).PasteSpecial  'tweak this as needed - I've gone with a new line in Col A for each file
    Workbooks(dataFile).Close
Next

Stop 'the next bit will save and close the new file...not sure if you want to
Workbooks(NewFileName).Save
Workbooks(NewFileName).Close

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub