Copy data from file XYZ_today's date to current sheet

288enzo

Well-known Member
Joined
Feb 8, 2009
Messages
717
Office Version
  1. 2016
Platform
  1. Windows
I have 5 files that are downloaded to \Downloads
Each file is a unique name_MMDDYYYY
Sheet0 is where the data is on each file
I'd like to copy Range("A3:S" & .Range("A" & Rows.Count).End(xlUp).Row) from each of the 5 files
And paste them in no particular order into a new file

As an example - If I wanted to work on this today, I would download the following files
MyField_87_87STX_LA_10192021.xls
MyField_84_84Atlanta_10192021.xls
MyField_83_83DC_MD_NC_SouthernVA_10192021.xls
MyField_82_82Florida_10192021.xls
MyField_80_80NTX_OK_10192021.xls

Using an old MrExcel thread - Copy range from one workbook to another and throwing in an input box I was able to create this:
VBA Code:
Sub Macro1()
Dim myDate As Long

myDate = (InputBox("Begining Date"))

Set wb2 = ActiveWorkbook

Set wb1 = Workbooks.Open("C:\Users\krichmp\Downloads\myfield_87_87STX_LA_" & myDate & ".xls")

wb1.Worksheets("Sheet0").Range("A3:S" & Range("A" & Rows.Count).End(xlUp).Row).Copy

Application.DisplayAlerts = False
' Copy to last row of data + 1 (can't get this to work)
wb2.Sheets("Sheet1").Range("A1:S" & wb2.Sheets("Sheet1").Range("A" & Rows.Count).End(xlDown).Row).PasteSpecial
Application.CutCopyMode = False
Range("A1").Select

' close each file data is copied from (can't get this to work)
Workbooks("C:\Users\krichmp\Downloads\myfield_87_87STX_LA_" & myDate & ".xls").Close SaveChanges:=False

Application.DisplayAlerts = True

End Sub

What I need help with is
How can I loop through with each of the file names? I assume using an Array.
knowing to paste data from each sheet under the previous set of pasted data in Sheet1 of the new blank file.
Closing the files data is copied from after paste
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Try this macro:
VBA Code:
Public Sub Copy_Range_From_Workbooks()
    
    Dim fileDate As String
    Dim matchWorkbooks As String, folderPath As String, wbFileName As String
    Dim destCell As Range
    Dim fromWorkbook As Workbook
    
    fileDate = InputBox("Enter file date (MMDDYYYY)", Title:="Import Data", Default:=Format(Date, "MMDDYYYY"))
    If StrPtr(fileDate) = 0 Then Exit Sub
    
    matchWorkbooks = "C:\Users\krichmp\Downloads\*_" & fileDate & ".xls"

    With ActiveWorkbook.Worksheets("Sheet1")
        Set destCell = .Cells(.Rows.Count, "A").End(xlUp)
        If destCell.Row > 1 Then Set destCell = destCell.Offset(1)
    End With
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
            
    folderPath = Left(matchWorkbooks, InStrRev(matchWorkbooks, "\"))
    wbFileName = Dir(matchWorkbooks)
    While wbFileName <> vbNullString
        Set fromWorkbook = Workbooks.Open(folderPath & wbFileName)
        With fromWorkbook.Worksheets("Sheet0")
            .Range("A3:S" & .Range("A" & .Rows.Count).End(xlUp).Row).Copy
        End With
        destCell.PasteSpecial
        fromWorkbook.Close SaveChanges:=False
        Set destCell = destCell.Worksheet.Cells(destCell.Worksheet.Rows.Count, "A").End(xlUp).Offset(1)
        DoEvents
        wbFileName = Dir
    Wend
    
    destCell.Select
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "Finished"

End Sub
 
Upvote 0
Try this macro:
VBA Code:
Public Sub Copy_Range_From_Workbooks()
   
    Dim fileDate As String
    Dim matchWorkbooks As String, folderPath As String, wbFileName As String
    Dim destCell As Range
    Dim fromWorkbook As Workbook
   
    fileDate = InputBox("Enter file date (MMDDYYYY)", Title:="Import Data", Default:=Format(Date, "MMDDYYYY"))
    If StrPtr(fileDate) = 0 Then Exit Sub
   
    matchWorkbooks = "C:\Users\krichmp\Downloads\*_" & fileDate & ".xls"

    With ActiveWorkbook.Worksheets("Sheet1")
        Set destCell = .Cells(.Rows.Count, "A").End(xlUp)
        If destCell.Row > 1 Then Set destCell = destCell.Offset(1)
    End With
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
           
    folderPath = Left(matchWorkbooks, InStrRev(matchWorkbooks, "\"))
    wbFileName = Dir(matchWorkbooks)
    While wbFileName <> vbNullString
        Set fromWorkbook = Workbooks.Open(folderPath & wbFileName)
        With fromWorkbook.Worksheets("Sheet0")
            .Range("A3:S" & .Range("A" & .Rows.Count).End(xlUp).Row).Copy
        End With
        destCell.PasteSpecial
        fromWorkbook.Close SaveChanges:=False
        Set destCell = destCell.Worksheet.Cells(destCell.Worksheet.Rows.Count, "A").End(xlUp).Offset(1)
        DoEvents
        wbFileName = Dir
    Wend
   
    destCell.Select
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
   
    MsgBox "Finished"

End Sub
I'm getting a compile error: wrong number of arguments.

Default:=format(Date, "MMDDYYYY")) - format is highlighted
 
Upvote 0
Try replacing Format with VBA.Format
OMG, you have no idea how much time you've saved me over the course of a week.

Thank you very much.

On a side note, how did you make "Format" and "VBA.Format" look as if they are code in your sentence. I know it must be one of these buttons on the tool bar.
 
Upvote 0
On a side note, how did you make "Format" and "VBA.Format" look as if they are code in your sentence. I know it must be one of these buttons on the tool bar.
The 'Inline code' icon:
1634673917726.png

gives: [ICODE]put code here[/ICODE]
 
Upvote 0

Forum statistics

Threads
1,213,506
Messages
6,114,025
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top