Open file based on text in filename

[jdash]

I am trying to create a procedure runs when a workbook is opened (Event: On_Open) that does that following:

1) Open a file with the text "ELA" in it from the same folder
2) Copy a specific set of cells from the first opened workbook (i.e. H15:I17)
3) Paste those cells into the "ELA" workbook in cell H1
4) Save and close both


Having trouble with how to open workbook with specific text of "ELA".


Thanks for the help.

 

[mumps]

Try this macro in the code module for ThisWorkbook. Change the sheet names to suit your needs. The macro assumes that the workbook is a macro-enabled file with an "xlsm" extension. If it isn't a macro enabled file, save it as such.

Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    Dim srcWb As Workbook
    Set srcWb = ThisWorkbook
    Dim desWB As String
    Dim FileName As String
    srcWb.Sheets("Sheet1").Range("H15:I17").Copy
    desWB = ThisWorkbook.Path & "\*ELA*.xls*"
    FileName = Dir(desWB)
    Workbooks.Open ThisWorkbook.Path & "\" & FileName
    Sheets("Sheet1").Range("H1").PasteSpecial
    ActiveWorkbook.Close True
    srcWb.Close True
    Application.ScreenUpdating = True
End Sub

 

[jdash]

Thanks for the quick reply all working .
Need some help with one more step. I want to copy and paste the formulas from the previous paste down the active columns.
Specifically after paste..
1) select H2:I2 and copy
2) select all the cells in those columns that are active (have data to the left)
3) then paste into corresponding H and I cells

Here is the code I have to date (along with yours) the code in red is where I think I am having the problem....

Private Sub Workbook_Open()
' Updates SBAC ELA and Math downloads into Excel. Sets these files up for import into Access GATE database
' Copies PercentRank FX and GATE Score into SBAC ELA and Math workbooks.

Application.ScreenUpdating = False

Dim srcWb As Workbook
Set srcWb = ThisWorkbook
Dim desWB As String
Dim FileName As String
Dim LastRow As Long


srcWb.Sheets("ELA and MATH Standards").Range("H17:I18").Copy
desWB = ThisWorkbook.Path & "\*SBAC ELA*.xls*"
FileName = Dir(desWB)
Workbooks.Open ThisWorkbook.Path & "" & FileName

Range("H1").Select
ActiveCell.PasteSpecial xlPasteAll


Range("H2:I2").Select
Application.CutCopyMode = False

Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
LastRow = Application.Selection.Cells.Count - 1
Range("H3:I" & LastRow).Select

ActiveSheet.PasteSpecial xlPasteAll
' Application.Selection.Cells.PasteSpecial xlPasteAll

Range("J2").Select

ActiveWorkbook.Close True

srcWb.Close True
Application.ScreenUpdating = True


Thanks for your help

 

[mumps]

See if this works for you:

Private Sub Workbook_Open()
    ' Updates SBAC ELA and Math downloads into Excel. Sets these files up for import into Access GATE database
    ' Copies PercentRank FX and GATE Score into SBAC ELA and Math workbooks.
    Application.ScreenUpdating = False
    Dim srcWb As Workbook
    Set srcWb = ThisWorkbook
    Dim desWB As String
    Dim FileName As String
    Dim LastRow As Long
    srcWb.Sheets("ELA and MATH Standards").Range("H17:I18").Copy
    desWB = ThisWorkbook.Path & "\*SBAC ELA*.xls*"
    FileName = Dir(desWB)
    Workbooks.Open ThisWorkbook.Path & "" & FileName
    Range("H1").PasteSpecial xlPasteAll
    Range("H2:I2").AutoFill Destination:=Range("H2:I" & Range("A" & Rows.Count).End(xlUp).Row)
    ActiveWorkbook.Close True
    srcWb.Close True
    Application.ScreenUpdating = True
End Sub

 

[jdash]

This worked perfectly. Many thanks for the prompt and valuable response!!

See if this works for you:

Private Sub Workbook_Open()
    ' Updates SBAC ELA and Math downloads into Excel. Sets these files up for import into Access GATE database
    ' Copies PercentRank FX and GATE Score into SBAC ELA and Math workbooks.
    Application.ScreenUpdating = False
    Dim srcWb As Workbook
    Set srcWb = ThisWorkbook
    Dim desWB As String
    Dim FileName As String
    Dim LastRow As Long
    srcWb.Sheets("ELA and MATH Standards").Range("H17:I18").Copy
    desWB = ThisWorkbook.Path & "\*SBAC ELA*.xls*"
    FileName = Dir(desWB)
    Workbooks.Open ThisWorkbook.Path & "" & FileName
    Range("H1").PasteSpecial xlPasteAll
    Range("H2:I2").AutoFill Destination:=Range("H2:I" & Range("A" & Rows.Count).End(xlUp).Row)
    ActiveWorkbook.Close True
    srcWb.Close True
    Application.ScreenUpdating = True
End Sub

 

[mumps]

You are very welcome.