VB Help - copying data from different sheets to one single sheet

[another31]

Hi All,

I was wondering if someone would be able to help with the below code that someone was very kind to provide the other day.

I need to copy about 18 sheets in a shared workbook and consolidate them into one sheet in a separate workbook (can be the same external workbook as where the macro is running from) with one set of headers.

I know excel gets a little funny with macros and sharing in the same workbook.

The below will pull the data out of the target completely fine...but only for the first sheet and replicates the first sheet a few times...and I must admit, I am rather lost.

Sub aMacro1()
Dim sht As Worksheet
Dim wbTarg  As Workbook
Dim wbSrc As Workbook
Dim vFile


Set wbTarg = ActiveWorkbook
vFile = UserPickFile("c:\")
If vFile <> "" Then
    Workbooks.Open vFile
    Set wbSrc = ActiveWorkbook
    For Each sht In Sheets
    
        Range("A1").Select
        ActiveSheet.UsedRange.Select
        Selection.Copy
        wbTarg.Activate
          ActiveSheet.Paste
          FarDown
          NextRow
        wbSrc.Activate
    Next
    
    MsgBox "Done"
Set sht = Nothing
Set wbSrc = Nothing
Set wbTarg = Nothing

End If
End Sub


Private Sub FarDown()
    Selection.End(xlDown).Select
End Sub


Private Sub NextRow()
ActiveCell.Offset(1, 0).Select
End Sub


Private Function UserPickFile(pvPath, Optional ByVal pvFilter)
Dim fD As Office.FileDialog
Dim varFile


Set fD = Application.FileDialog(msoFileDialogFilePicker)
'With Application.FileDialog(msoFileDialogSaveAs)
With fD
   ' Allow user to make multiple selections in dialog box
   .AllowMultiSelect = False
          
   ' Set the title of the dialog box.
   .Title = "Please select one or more files"


   ' Clear out the current filters, and add our own.
   .Filters.Clear
   .Filters.Add "All Files", "*.*"
   .Filters.Add "Excel files", "*.xls*"
   '.Filters.Add "Access Databases", "*.mdb"
   '.Filters.Add "Documents", "*.doc*"
   '.Filters.Add "Acrobat", "*.pdf"
   '.Filters.Add "Image", "*.jpg;*.png"


   
        ' Show the dialog box. If the .Show method returns True, the
        ' user picked at least one file. If the .Show method returns
        ' False, the user clicked Cancel.
   If .Show = True Then
      If .AllowMultiSelect Then
             'MULTI SELECT version
                'Loop through each file selected and add it to our list box.
            For Each varFile In .SelectedItems
               'Me.FileList.AddItem varFile
            Next
      Else
         UserPickFile = .SelectedItems(1)
      End If
   End If
End With
Set fD = Nothing
End Function

Any help with the above will be very gratefully received as my knowledge of VB is very basic.

Another31