Excel VBA. Copy data from multiple workbooks and paste in one workbook same worksheet

Question

I have a code which enables a user to open a workbook and copies contents of sheet automatically to another workbook sheet. How can I select a folder of multiple workbooks and copy data from each workbook and paste to one workbook same sheet.

Basically after 1st file is found it should copy contents and paste then copy another file paste in after contents of other sheet. Below is the code that I have.

Sub uploadFile()

Application.ScreenUpdating = False  ' disable screen updating

Dim sPath As String   ' Path names in getopenfilename
sPath = "C:\Users\Desktop\November"   

' find the network path
If SetUNCPath(sPath) <> 0 Then

    ' message to show to pick a file
    MsgBox "Select the text file '"
    FileToOpen = Application.GetOpenFilename(Title:="Please choose a file to import")

    ' if the user doens't select a file the sub should terminate and do nothing
    If FileToOpen = False Then
        MsgBox "No file specified.", vbExclamation, "Alert!!!"
            Exit Sub
    Else
      ' Clear contents in Template
      If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False 'Remove Filters if exists
      LastRow = ActiveSheet.Range("A1").Offset(ActiveSheet.Rows.Count - 1, 0).End(xlUp).Row
      If LastRow > 1 Then Worksheets("Data").Range("A2:AL" & LastRow).Clear

      ' open work book and assign splits
      Workbooks.OpenText Filename:= _
      FileToOpen, _
      Origin:=437, StartRow:=1, DataType:=xlFixedWidth, _
      FieldInfo:=Array(Array(0, 1), Array(6, 1), Array(38, 1), Array(45, 1), Array(54, 1), _
      Array(84, 1), Array(91, 1), Array(99, 1), Array(100, 1), Array(106, 1), Array(114, 1), Array(118, 1), Array(121, 1), _
      Array(133, 1), Array(148, 1), Array(151, 1), Array(160, 1), Array(182, 1), _
      Array(190, 1), Array(198, 1), Array(218, 1), Array(219, 1), Array(228, 1), _
      Array(248, 1), Array(260, 1), Array(271, 1), Array(278, 1), Array(289, 1), Array(300, 1), Array(311, 1), Array(315, 1), _
      Array(326, 1), Array(333, 1), Array(340, 1), Array(347, 1), Array(351, 1), Array(357, 1), Array(410, 1)), TrailingMinusNumbers:=True_

      ' splits the path
      SplitPath = Split(FileToOpen, Application.PathSeparator)
      Filename = SplitPath(UBound(SplitPath))

      ' Copy contents from file
      If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False 'Remove Filters if exists
      LastRow = ActiveSheet.Range("A1").Offset(ActiveSheet.Rows.Count - 1, 0).End(xlUp).Row
      Range("A1:AF" & LastRow).Copy

      ' error if file name changes
      Windows("TEMPLATE BPLG.xlsb").Activate
      Sheets("Data").Select 'Select the sheet
      Range("A2").PasteSpecial Paste:=xlPasteValues

      ' Extract the file name of the source file
      SplitPath = Split(FileToOpen, Application.PathSeparator)
      Filename = SplitPath(UBound(SplitPath))
      FileDT = FileDateTime(FileToOpen)

      ' Close the Source file
      Windows(Filename).Activate
      Application.DisplayAlerts = False
      ActiveWindow.Close
      Application.DisplayAlerts = True
      Range("A1").Select

      ' Formulas
      [AG2] = "=Z2/100"
      [AH2] = "=AA2/100"
      [AI2] = "=AB2/100"
      [AJ2] = "=AC2/100"
      [AK2] = "=AD2/100"
      [AL2] = "=AG2-AH2-AI2-AJ2-AK2"

      ' Copy down
      [AG2:AL2].Copy
      LastRow = ActiveSheet.Range("A1").Offset(ActiveSheet.Rows.Count - 1, 0).End(xlUp).Row
      Range("AG2:AL" & LastRow).Select
      ActiveSheet.Paste

    End If
End If

' Reset
Sheets("HOME").Select   ' Go to Home
Range("A1").Select      ' go to A1
Application.ScreenUpdating = True 'enable screen updating

' message to display the process is completed
MsgBox "Step complete"

End Sub

Harassed Dad Harassed Dad · Accepted Answer · 2017-11-10T14:22:47

 Dim sPath As String   ' Path names in getopenfilename
 sPath = "C:\Users\Desktop\November"   
 dim s as string
 dim wb as workbook
' find the network path
 If SetUNCPath(sPath) <> 0 Then
  s = dir(spath & "\*.xls?")  'find first spreadsheet in folder
  Do
     'open file for processing
     set wb = workbooks.opentext(filename:=spath & "\" & s,.....etc
      'etc...
     wb.close false 'close without saving
     s = dir() 'find subsequent files
 loop until s = ""


 End If

Excel VBA. Copy data from multiple workbooks and paste in one workbook same worksheet

1 Answers