VBA - Copy Sheet from a workbook saved as a date - paste to specifically named sheet in another workbook based on the date

[Insurance Dave]

Hello Everyone,

Getting older, but not so much wiser. My VBA skills were always lacking, but now they are also 15 years out of practice. I would post the attempts I have made, but it would be embarrassing...

I am looking for VBA code to copy an entire sheet from one workbook to an existing, already named sheet within another workbook based on the name of the source workbook and the name of the destination tab/worksheet.

The source workbook is created by exporting data from another source into a new Excel Workbook. There is only ever one worksheet in this workbook - "Claim Specific AFO Claim Handle". Once imported, the source workbook will be manually saved as today's date in the mm-dd-yyyy.xlsx format (i.e. 03-26-2024.xlsx) within a folder on the User's Desktop named WLB. The Workbook can either be closed at this time or remain open - pending responses from everyone here on the best choice for this application.

In the User's workbook, I am looking to have a button with the VBA assigned, to copy the worksheet from the most recently saved source workbook and paste the data into a specific tab within the User's workbook, overwriting any and all previous data on that tab/within that worksheet. The code would need to identify that 04/02/2024 is more recent than 04/01/2025 or 03/29/2024, etc. So, data copied and pasted on 04-01-2024 will be overwritten with the data from the 04-02-2024 workbook/worksheet and so-on. The number of columns and rows may vary from day-to-day within the source worksheet. There should never be more than 250 columns or rows.

This will be a daily process for the User (mostly workdays).

Source Workbook Location - C:\Users\****\Desktop\WLB\
Source Workbook Name will be date driven - mm-dd-yyyy.xlsx
Source Worksheet Name / Tab Name (only sheet within the workbook) - "Claim Specific AFO Claim Handle"

User's Workbook will be open
User's Worksheet Name where data is to be copied to - "MM_YYYY_Data" where the "MM" and the "YYYY" will be the month and year based on the date of the most recently saved sourcebook - with the paste starting in Cell A1. So, if the most recent source workbook in the WLB folder is 04-02-2024.xlsx, the data will be pasted to the User's Workbook within the sheet named April_2024_Data.

Numerous other tabs/worksheets/cells within the User's Workbook will be formulae driven based on the data that is pasted to the designated worksheet (mostly vlookups) - in case ScreenUpdating or something else would be a factor.

Hopefully, this is enough information to go on. I thank anyone/everyone in advance for any help with this.

Dave

 

[bobaol]

Assume you're allowed to change your process slightly. Source book is the imported data. Open your workbook and leave it open. "Claim Specific AFO Claim Handle.xlsx". The workbook with all the dates in each sheet needs to be named "user workbook with dates.xlsm". You can change the name if you want, but if you change the name, you will need to change the name in the code as well. Easy enough to do so, just find and replace. You must save this workbook as a Macro Enabled Workbook. Manually open this book, and leave it open. Copy and paste the macro below into your workbook. This workbook has a sheet named "Worksheet Names". This worksheet must exist, in order to find which sheet it the most recent. The name of the sheets, when it is a date, must be in this format 06-04-1989
for example, where it is month-date-year (June 4th 1989), with the leading zeros. Run this macro. macro02_run_all_ cheers!

Option Explicit

Sub Now_ListWorksheets2()
Dim aWB As Excel.Workbook
Dim WS As Excel.Worksheet
Dim myWS As Excel.Worksheet
Dim lRow As Long

    Sheets("Worksheet Names").Select
    Application.Goto Reference:="R1C1"


Set aWB = ActiveWorkbook
On Error Resume Next
Set myWS = aWB.Worksheets("Worksheet Names")
On Error GoTo 0
If myWS Is Nothing Then

    Set myWS = aWB.Worksheets.Add
    myWS.Move before:=aWB.Worksheets(1)
    myWS.Name = "Worksheet Names"
Else
    myWS.UsedRange.ClearContents
End If

lRow = 0
For Each WS In aWB.Worksheets
    lRow = lRow + 1
    myWS.Cells(lRow, 1) = WS.Name
  
Next WS

End Sub

Sub macro02_run_all_()
    Application.DisplayAlerts = False
    Application.Run " Macro03"
    Application.Run " Macro04"
    Application.Run " Macro06"
    Application.Run " Macro08"
    Application.Run " Macro10"
    Application.Run " Macro11"
    Application.Run " Macro13"
  
    Application.Run " Macro14"
    Application.Run " Macro16"
    Application.Run " Macro17"
    Application.Run " Macro19"

    msgbox "done."
End Sub


Sub Macro03()
 '''to find all sheet names.
'''change this file name, if you want  "user workbook with dates.xlsm",
'''but you cannot change the sheet name.  the sheet name and the sheet must remain as is.
    Windows("user workbook with dates.xlsm").Activate
    Sheets("Worksheet Names").Select
    Application.Goto Reference:="R1C1"
    Application.Run "Now_ListWorksheets2"
End Sub

Sub Macro04()
    Sheets("Worksheet Names").Select
    Selection.ColumnWidth = 22
  
'parse and format into date
    Application.Goto Reference:="R1C1"
    ActiveCell.Columns("A:A").EntireColumn.Select
    Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
    Selection.NumberFormat = "mm-dd-yyyy;@"
  
'''insert ten rows.  it is much easier to work when there is blank space to work in.
    Application.Goto Reference:="R1C1"
    ActiveCell.Range("A1:A10").Select
    Selection.EntireRow.Insert
End Sub

Sub Macro06()
'find the maximum number of sheets in your workbook, paste the value in A1 for use later
    Sheets("Worksheet Names").Select
    Application.Goto Reference:="R999999C1"
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.Clear
    Selection.FormulaR1C1 = "=ROW()"
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Cut
    Application.Goto Reference:="R1C1"
    ActiveSheet.Paste
    Application.Goto Reference:="R1C2"
End Sub

Sub Macro08()
''  define today's date and the dates in each sheet in B to M
    Sheets("Worksheet Names").Select
    Application.Goto Reference:="R11C1"
    Application.Goto Reference:="R11C2"
    Selection.FormulaR1C1 = "=YEAR(RC[-1])"
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.FormulaR1C1 = "=RIGHT(""0""&MONTH(RC[-2]),2)"
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.FormulaR1C1 = "=RIGHT(""0""&DAY(RC[-3]),2)"
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.FormulaR1C1 = "=NOW()"
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.FormulaR1C1 = "=YEAR(RC[-1])"
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.FormulaR1C1 = "=RIGHT(""0""&MONTH(RC[-2]),2)"
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.FormulaR1C1 = "=RIGHT(""0""&DAY(RC[-3]),2)"
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.FormulaR1C1 = "=RC[-2]&""-""&RC[-1]&""-""&RC[-3]"
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.FormulaR1C1 = "=DATEVALUE(RC[-1])"
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.FormulaR1C1 = "=RC[-10]>=RC[-1]"
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.FormulaR1C1 = "=IF(ISERROR(RC[-10]),"""",RC[-11])"
    Application.Goto Reference:="R11C12"
    Selection.FormulaR1C1 = "=IF(ISERROR(RC[-10]),"""",RC[-11])"
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.FormulaR1C1 = "=IF(RC[-1]="""","""",IF(RC[-12]>RC[-3],"""",RC[-12]))"
    Application.Goto Reference:="R11C2"
    ActiveCell.Range("A1:L1").Select
    Selection.Copy
''    ActiveCell.Range("A1:L19").Select
''copy and paste the number of rows based on the number in cell A1
    ActiveCell.Range("A1:L" & Range("a1")).Select
    ActiveSheet.Paste
    Application.Goto Reference:="R1C5"
    ActiveCell.Columns("A:A").EntireColumn.Select
  
'''format all the date columns
    Selection.NumberFormat = "mm-dd-yyyy;@"
    Selection.Copy
    ActiveCell.Offset(0, 4).Range("A1").Select
    Application.Goto Reference:="R1C9"
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.Goto Reference:="R1C10"
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.Goto Reference:="R1C12"
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.Goto Reference:="R1C13"
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub

Sub Macro10()
'use max to find the most recent sheet based on date
    Sheets("Worksheet Names").Select
    Application.Goto Reference:="R2C1"
    Selection.FormulaR1C1 = "=MAX(C[12])"
    Selection.Copy
    Application.Goto Reference:="R1C2"
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.ColumnWidth = 22
End Sub

Sub Macro11()
''define the most recent sheet in cell B7.
''now you know which sheet is the most recent sheet
    Sheets("Worksheet Names").Select
    Application.Goto Reference:="R1C2"
    Application.Goto Reference:="R2C2"
    ActiveCell.FormulaR1C1 = "=YEAR(R[-1]C)"
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=RIGHT(""0""&MONTH(R[-2]C),2)"
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=RIGHT(""0""&DAY(R[-3]C),2)"
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "'-"
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=R[-3]C&R[-1]C&R[-2]C&R[-1]C&R[-4]C"
    ActiveCell.Offset(1, 0).Range("A1").Select
    Application.Goto Reference:="R6C2"
    Selection.Copy
    Application.Goto Reference:="R7C2"
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

End Sub

Sub Macro13()
'go to your most recent sheet, based on cell A7
    Sheets("Worksheet Names").Select
    Application.Goto Reference:="R1C1"
''    Sheets("04-01-2024").Select
    Sheets(Range("b7").Text).Select
    Application.Goto Reference:="R1C1"
End Sub

Sub Macro14()
''go to your workbook  Claim Specific AFO Claim Handle.xlsx
'' you have only one sheet.  rename the sheet to Temp.  will re-name it back later with a date instead
    Windows("Claim Specific AFO Claim Handle.xlsx").Activate
''    Sheets("Sheet1").Select
''    Sheets("Sheet1").Name = "Temp"
'' Use ActiveSheet instead of a hard-reference to Sheet1 of the workbook.
    ActiveSheet.Select
    ActiveSheet.Name = "Temp"
 
'''insert ten rows to have blank space to work with.  will delete these ten rows later
''define today's date in cell A7.  Will use cell A7 to rename your file.
    Windows("Claim Specific AFO Claim Handle.xlsx").Activate
    Application.Goto Reference:="R1C1"
    ActiveCell.Range("A1:A10").Select
    Selection.EntireRow.Insert
    Application.Goto Reference:="R1C1"
    Selection.FormulaR1C1 = "=NOW()"
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ActiveCell.Offset(1, 0).Range("A1").Select
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    Selection.FormulaR1C1 = "=YEAR(R[-1]C)"
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.FormulaR1C1 = "=RIGHT(""0""&MONTH(R[-2]C),2)"
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.FormulaR1C1 = "=RIGHT(""0""&DAY(R[-3]C),2)"
    ActiveCell.Offset(3, 0).Range("A1").Select
    Application.Goto Reference:="R5C1"
    ActiveCell.FormulaR1C1 = "'-"
    ActiveCell.Offset(2, 0).Range("A1").Select
    Application.Goto Reference:="R6C1"
    Selection.FormulaR1C1 = "=R[-3]C&R[-1]C&R[-2]C&R[-1]C&R[-4]C"
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Calculate
 End Sub

Sub Macro16()
'copy today's data into the most recent sheet.  A1 to IP300 are copied.
    Windows("Claim Specific AFO Claim Handle.xlsx").Activate
    Application.Goto Reference:="R1C1"
    ActiveCell.Range("A1:IP300").Select
    Application.CutCopyMode = False
    Selection.Copy
    Application.CutCopyMode = False
    Calculate
    Selection.Copy
    Windows("user workbook with dates.xlsm").Activate
    Application.Goto Reference:="R1C1"
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

''delete those ten rows from earlier
    Application.Goto Reference:="R1C1"
    ActiveCell.Range("A1:A10").Select
    Application.CutCopyMode = False
    Selection.EntireRow.Delete
    Application.Goto Reference:="R1C1"
End Sub

Sub Macro17()
    Windows("Claim Specific AFO Claim Handle.xlsx").Activate
    Application.Goto Reference:="R1C1"
'define your file with a date in cell A9.  i think it is more intuitive to date it with year, month, day
    Application.Goto Reference:="R8C1"
    ActiveCell.FormulaR1C1 = "=R[-6]C&R[-3]C&R[-5]C&R[-3]C&R[-4]C"
    Application.Goto Reference:="R9C1"
    Selection.FormulaR1C1 = "=""Claim Specific AFO Claim Handle  ""&R[-1]C&"".xlsx"""

'if you want month, day, year, use this code to refer to cell A7 instead
''    Selection.FormulaR1C1 = "=""Claim Specific AFO Claim Handle  ""&R[-2]C&"".xlsx"""


'save as cell A9, with a date
    Application.DisplayAlerts = False
    Windows("Claim Specific AFO Claim Handle.xlsx").Activate
    Application.Goto Reference:="R1C1"
''    ChDir "C:\Users\June4th1989\Desktop\WLB"
''    ActiveWorkbook.SaveAs Filename:="C:\Users\June4th1989\Desktop\WLB\Claim Specific AFO Claim Handle.xlsx save as cell A9.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.SaveAs Filename:="C:\Users\xyz\Desktop\WLB\" & Range("a9"), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub
Sub Macro19()
'''name sheet as range A7, the date
    Sheets("Temp").Select
  '''  Sheets("Temp").Name = "rangea7"
    Sheets("Temp").Name = Range("a7")
    ActiveWorkbook.Save
'delete those ten rows from earlier
    Windows("Claim Specific AFO Claim Handle  2024-04-01.xlsx").Activate
    Application.Goto Reference:="R1C1"
    ActiveCell.Range("A1:A10").Select
    Selection.EntireRow.Delete
    Application.Goto Reference:="R1C1"
    ActiveWorkbook.Save
  
    Windows("user workbook with dates.xlsm").Activate
    Application.Goto Reference:="R1C1"

End Sub

 

[Insurance Dave]

Hi bobaol,

Thank you for reviewing this and for your response. I will give it a shot and see what I come up with.

Cheers!