Copying from a worksheet to another workbook where both change dates

[Mykahlia]

Hello,

I am new to VBA and I am hoping someone can help me figure out this issue. I tried setting up a macro to copy data from one worksheet that I download daily in to a another workbook that we update the file by save as file with the same name but change the date.

This is an example of the worksheet.

As you can see the worksheet name changes each day it is downloaded. Where I need to copy in to is the workbook that we update the date daily on.

I have already set up a macro for sorting as needed before pasting in to the workbook. I just cant figure out how to get it to copy with VBA or Macro with the name changes. Any help is appreciated. Thank you.

 

[HighAndWilder]

it represents as 02-17-2025 so basically it is SSC Prod - Report -02-17-2025.xlsx

Try this on copies of your data.

It prompts for both the destination workbook and the CSV file.

Do you want to avoid the prompts? This will only work if the destination file and source file with the date in the filename exist.

Public Sub subImportDailyDataV2()
Dim strFileName As Variant
Dim strFileSelected As Variant
Dim WbDestination As Workbook
Dim WsDestination As Worksheet
Dim WsSource As Worksheet
Dim arr() As Variant
Dim strCorrectFolder As String
Dim strFolder As String
Dim arrFile() As String
Dim i As Integer
Dim strFileTemplate As String
Dim blnIsOpen As Boolean
Dim Wb As Workbook

  ActiveWorkbook.Save
  
  For Each Wb In Workbooks
    If Wb.Name <> ThisWorkbook.Name Then Wb.Close True
  Next
    
  strCorrectFolder = "C:\Mod Squad\01.Projects - Mod Squad\FY25 Credentials\Team Reports\"
   
  strFileTemplate = "SSC Prod - Report -"   ' 02-17-2025.xlsx
  
  strFileSelected = Application.GetOpenFilename(Title:="Browse for Destination Workbook.", FileFilter:="Excel Files (*.xls*),*xls*")
  
  ' Abort if no file selected.
  If strFileSelected = False Then
    Exit Sub
  End If
  
  ' Check to see if the file is from the correct folder and the file name is likely to be correct.
  ' Abort if appropriate.
  If (strFileSelected Like strCorrectFolder & strFileTemplate & "*" = False) Then
    Exit Sub
  End If
  
  arrFile = Split(strFileSelected, "\")
  
  strFileName = arrFile(UBound(arrFile))
    
  blnIsOpen = fncCheckWorkbookOpenByPath(strFileSelected)
  
  If MsgBox("Import data into workbook for " & Replace(Right(strFileName, 15), Right(strFileName, 5), "") & "?", vbYesNo, "Date Check.") = vbNo Then
    If blnIsOpen Then
      Workbooks(strFileName).Close True
    End If
    Exit Sub
  End If
  
  If Not (blnIsOpen) Then
    Workbooks.Open strFileSelected
  End If
    
  Set WbDestination = Workbooks(strFileName)
  
  WbDestination.Activate
  
  ' Check to see if the 'All IDs' worksheet exists in the workbook.
  ' Add worksheet if necessary.
  If Not Evaluate("isref('" & "All IDs" & "'!A1)") Then
    With WbDestination
      Set WsDestination = .Sheets.Add(After:=.Sheets(.Sheets.Count))
      WsDestination.Name = "All IDs"
    End With
  Else
    Set WsDestination = WbDestination.Worksheets("All IDs")
  End If
   
  ' Prompt for the Daily Download workbook.
  strFileSelected = Application.GetOpenFilename(Title:="Browse for Daily Download CSV file.", FileFilter:="CSV Files (*.csv*),*csv*")
  
  If strFileSelected = False Or Right(strFileSelected, 3) <> "csv" Then
    ' Message to warn that no file was selected.
    MsgBox "No Daily Download workbook has been selected.", vbOKOnly, "Warning"
    Exit Sub
  End If
  
  ' Open the selected workbook.
  Workbooks.Open strFileSelected
        
  ' Assumes that the data needed is in sheet 1.
  Set WsSource = ActiveWorkbook.Sheets(1)
      
  ' Copies the source data to an array.
  arr = WsSource.Range("A1").CurrentRegion
    
  ' Writes the data to the sheet specified in WsDestination.
  WsDestination.Cells(WsDestination.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Resize(UBound(arr), UBound(arr, 2)).Value = arr
  
  WbDestination.Save
  
  ' Closes the Daily Download workbook.
  ActiveWorkbook.Close False
    
  ' Confirmation message.
  ' MsgBox UBound(arr) & " rows of data copied from " & strFileName, vbOKOnly, "Confirmation"
  
  For Each Wb In Workbooks
    If Wb.Name <> ThisWorkbook.Name Then Wb.Close True
  Next
  
  ActiveWorkbook.Save
  
End Sub

Private Function fncCheckWorkbookOpenByPath(ByVal strFileName As String)
Dim filenumber As Long, lngErrorNumber As Long

  On Error Resume Next
  
  filenumber = FreeFile()
  
  Open strFileName For Input Lock Read As #filenumber
  
  Close filenumber
  
  lngErrorNumber = Err
  
  On Error GoTo 0
  
  Select Case lngErrorNumber
  
    Case 0: fncCheckWorkbookOpenByPath = False
    
    Case 70: fncCheckWorkbookOpenByPath = True
     
  End Select
  
End Function

 

[Mykahlia]

Thank you, That worked.