Pulling data from multiple files and naming the data accordingly in Excel

Question

I have a macro I am running that pulls data from numerous files within a folder and pastes the contents of that sheet in the file into one master file. All the data is pasted in the master file correctly, however I need to have the name of the file the data was taken from pasted into the master file as well.

My macro is:

  Dim MyFile As String, Sep As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False

    Dim wks1 As Worksheet, wks2 As Worksheet, objwb As Workbook, objwb0 As Workbook
    Dim last_rowcurent As Long
    Dim last_row As Long
        Sheets("Warnings").Select
    last_rowcurent = Range("B1").End(xlDown).Row + 1
    Set objwb0 = ActiveWorkbook
    Set wks1 = objwb0.Worksheets("Warnings")


  ' Sets up the variable "MyFile" to be each file in the directory
  ' This example looks for all the files that have an .xls extension.
  ' This can be changed to whatever extension is needed. Also, this
  ' macro searches the current directory. This can be changed to any
  ' directory.

  '' Test for Windows or Macintosh platform. Make the directory request.
  Sep = Application.PathSeparator

  'If Sep = "\" Then
     ' Windows platform search syntax.
     MyFile = Dir("P:\Frame\Frame_Piercing\Metrics_Development\Inmagusa\Warnings" & Sep & "*.xls")

  'Else

     ' Macintosh platform search syntax.
     'MyFile = Dir("", MacID("XLS5"))
  'End If

  ' Starts the loop, which will continue until there are no more files
  ' found.
  Do While MyFile <> ""
    Application.ScreenUpdating = False
    Application.CutCopyMode = False

     ' Displays a message box with the name of the file. This can be
     ' changed to any procedure that would be needed to run on every
     ' file in the directory such as opening each file.
    last_rowcurent = wks1.Range("B2").End(xlDown).Row + 1
    Set objwb = Workbooks.Open("P:\Frame\Frame_Piercing\Metrics_Development\Inmagusa\Warnings" & Sep & MyFile)
    Set wks2 = objwb.Worksheets("navistar-warnings")
        Sheets("navistar-warnings").Select
    last_row = wks2.Range("A2").End(xlDown).Row
    If Not IsEmpty(Range("A2")) Then



        'MsgBox last_row
        wks2.Range("A2:h" & last_row).Select
        Selection.Copy
        Workbooks("Inmagusa_Merge_Files.xlsm").Activate
        Worksheets("Warnings").Range("A1").Select
        'Sheets("Errors").Select
        last_rowcurent = ActiveSheet.Range("B1").End(xlDown).Row + 1
        ActiveSheet.Range("A" & last_rowcurent).Select
        'ActiveWorkbook.Worksheets("Release").Range("A" & lastrowcurent).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        'Selection.PasteSpecial Paste:=x1PasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=True, Transpose:=False

        'wks1.Range("A" & last_rowcurent).PasteSpecial(Paste:=x1PasteValues, Paste:=x1PasteFormats, Operation:= _
        x1None, SkipBlanks:=False, Transpose:=False)
        'wks1.Range("A" & last_rowcurent).Select
        'Selection.PasteSpecial Paste:=xlPasteValues, x1PasteFormats, Operation:= _
        'xlNone, SkipBlanks:=False, Transpose:=False

        'wks2.Range("A4:w" & last_row).Copy
        'wks1.Range("A" & last_rowcurent).Select
        'Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        'SkipBlanks:=False, Transpose:=False

        'Workbooks("Frame_WorkPlanning_Master.xlsm").Activate
        'last_rowcurent = ActiveWorkbook.Worksheets("Release").Range("A3").Row
        'ActiveWorkbook.Worksheets("Release").Range("a3").Paste
           'With wks1.Range("A" & last_rowcurent)
               '.PasteSpecial Paste:=xlPasteColumnWidths
               '.PasteSpecial Paste:=xlPasteFormats
               '.PasteSpecial Paste:=xlValue
                'or other parameters...
           'End With
    End If
       objwb.Close False


     'MsgBox "P:\Frame\Work_Planning\Engineer_Plans" & Sep & MyFile
     MyFile = Dir()
  Loop
'ActiveWorkbook.Worksheets("Release").Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowSorting:=True, AllowFiltering:=True, AllowFormattingCells:=True, AllowUsingPivotTables:= _

I need the file name pasted in column 'I' but the amount of rows varies with the data in each separate file.

Any help would be greatly appreciated!

score 0 · Accepted Answer · edited May 23 '17 at 12:22

You have a lot of code that is commented out which make it a little difficult to follow. I ignored all the commented code and rewrote the part in question to eliminate Active & Select. See this post to learn more about why this is a good idea.

The file name is now printed in column I on the first row of new data being pasted

Dim wbSource As Workbook
Set wbSource = Workbooks("Inmagusa_Merge_Files.xlsm")

If Not IsEmpty(Range("A2")) Then
    wks2.Range("A2:h" & last_row).Copy

    last_rowcurent = wbSource.Worksheets("Warnings").Range("B1").End(xlDown).Row + 1

    ' Put file name in Column I on the first row of new data
    wbSource.Worksheets("Warnings").Range("I" & last_rowcurent).Value = objwb.Name

    wbSource.Worksheets("Warnings").Range("A" & last_rowcurent).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If

EDIT

To paste the name in Column I for every row of new data you can loop like this:

Dim wbSource As Workbook
Set wbSource = Workbooks("Inmagusa_Merge_Files.xlsm")

If Not IsEmpty(Range("A2")) Then
    Dim copyRange As Range
    Set copyRange = wks2.Range("A2:h" & last_row)

    copyRange.Copy

    last_rowcurent = wbSource.Worksheets("Warnings").Range("B1").End(xlDown).Row + 1

    ' Put file name in Column I on the first row of new data
    'wbSource.Worksheets("Warnings").Range("I" & last_rowcurent).Value = objwb.Name

    ' Put file name in Column I for every row being pasted
    For j = 1 + last_rowcurent To copyRange.Rows.Count + last_rowcurent
        wbSource.Worksheets("Warnings").Range("I" & j).Value = objwb.Name
    Next j

    wbSource.Worksheets("Warnings").Range("A" & last_rowcurent).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If

Note that I commented out the single line code and added in a For loop to print the name for every cell.

Thank you for your response. I am just starting with this stuff, so a little unfamiliar with it all - Where does this portion go within my current text? — user3066744, Dec 04 '13 at 18:38
Take my code and use it to replace everything After `last_row = wks2.Range("A2").End(xlDown).Row` and `Before objwb.Close False` — Automate This, Dec 04 '13 at 19:12
Awesome, works great!! Thank you so much. Last question would be if there is a way to get it to paste to all rows of the data that it is being pulled from in column I? — user3066744, Dec 04 '13 at 19:49
Glad it worked for you. I edited my answer to include the ability to print the name on every row for the data being pasted. — Automate This, Dec 04 '13 at 22:23
I really appreciate all your help with this. Currently, I am using this code and it is not pulling the last file in the folder, and when pasting the file names it pastes one row under the last row. I will keep playing around with it, but if you have any additional advice I would greatly appreciate it. — user3066744, Dec 05 '13 at 17:09

Pulling data from multiple files and naming the data accordingly in Excel

1 Answers1