Search code examples
excelvbacopypaste

Is there a way to set an open workbook as a source without having the file name?


I am trying to write a code that opens the most recent file in a folder and copy data from it. I am having trouble setting it as a source for the copying without the specific file name. I do not want to set a file name as I just want it to take the most recent file and copy it.

I was able to get it to open the most recent file, but it is getting stuck on source data. My goal is to not have to manually select a file every time a newer one comes out.

Sub CopyDataFromCSVFiles()

    Dim SourceFolder As String
    Dim MasterWorkbook As Workbook
    Dim CurrentData As Workbook
    Dim DataSheet As Worksheet
    Dim MasterSheet As Worksheet
    Dim CSVFile As String
    Dim NextRow As Long
    Dim FileExtension As String
    
    ' Set the source folder containing CSV files
    SourceFolder = "P:\Fluid Products Engineering\EOP Tester Data\Combination Program\Raw Data\"
    
    ' Set the master workbook (file picker dialog)
    Set MasterWorkbook = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm), *.xls; *.xlsx; *.xlsm", Title:="Please select the master workbook")
    
    If MasterWorkbook = "False" Then
        MsgBox "No master workbook selected. Exiting..."
        Exit Sub
    Else
        Set MasterWorkbook = Workbooks.Open(MasterWorkbook)
    End If
    
    ' Set master worksheet
    Set MasterSheet = MasterWorkbook.Sheets(1)
    
    ' Loop through each file in the folder
    CSVFile = Dir(SourceFolder & "*.csv")
    Do While CSVFile <> ""
        ' Open current CSV file
        Set CurrentData = Workbooks.Open(SourceFolder & CSVFile)
        
        ' Set current data worksheet
        Set DataSheet = CurrentData.Sheets(1)
        
        ' Determine the next available row in master workbook
        NextRow = MasterSheet.Cells(MasterSheet.Rows.Count, "A").End(xlUp).Row + 1
        
        ' Copy data from current CSV file to master workbook
        DataSheet.UsedRange.Copy MasterSheet.Cells(NextRow, 1)
        
        ' Close current CSV file without saving changes
        CurrentData.Close False
        
        ' Get next CSV file
        CSVFile = Dir
    Loop
    
    ' Close master workbook with saving changes
    MasterWorkbook.Close True
    
    MsgBox "Data has been successfully copied to the master workbook.", vbInformation

End Sub


Solution

  • Copy From One Closed Workbook to Another (PERSONAL.xlsb!?)

    Sub CopyRawData()
        
        Const SRC_FOLDER_PATH As String = "U:\Documents\Macro Testing\Raw Data\"
        Const SRC_FILE_PATTERN As String = "SLTEST_*.csv"
        Const SRC_FIRST_ROW_RANGE As String = "A2:G2"
        
        Const DST_FILE_PATH As String _
            = "U:\Documents\Macro Testing\Data\Finished Data.xlsx"
        Const DST_SHEET_NAME As String = "Banana"
        Const DST_FIRST_CELL As String = "A2"
        
        Dim sFileName As String: sFileName = Dir(SRC_FOLDER_PATH & SRC_FILE_PATTERN)
        
        If Len(sFileName) = 0 Then
            MsgBox "No file matching the pattern """ & SRC_FILE_PATTERN _
                & """ found in """ & SRC_FOLDER_PATH & """!", vbExclamation
            Exit Sub
        End If
        
        Dim sFilePath As String, sFilePathFound As String
        Dim sFileDate As Date, sFileDateFound As Date
        
        Do While Len(sFileName) > 0
            sFilePathFound = SRC_FOLDER_PATH & sFileName
            sFileDateFound = FileDateTime(sFilePathFound)
            If sFileDate < sFileDateFound Then
                sFileDate = sFileDateFound
                sFilePath = sFilePathFound
            End If
            sFileName = Dir
        Loop
            
        Application.ScreenUpdating = False
            
        Dim swb As Workbook: Set swb = Workbooks.Open(sFilePath, , True) ' , Local:=True)
        Dim sws As Worksheet: Set sws = swb.Sheets(1)
        
        Dim srg As Range, slcell As Range, rCount As Long
        
        With sws.Range(SRC_FIRST_ROW_RANGE)
            Set slcell = .Resize(sws.Rows.Count - .Row + 1) _
                .Find("*", , xlValues, , xlByRows, xlPrevious)
            If slcell Is Nothing Then
                swb.Close SaveChanges:=False
                MsgBox "No data found in workbook """ & sFilePath & """!", _
                    vbExclamation
                Exit Sub
            End If
            rCount = slcell.Row - .Row + 1
            Set srg = .Resize(rCount)
        End With
                
        Dim dwb As Workbook: Set dwb = Workbooks.Open(DST_FILE_PATH)
        Dim dws As Worksheet: Set dws = dwb.Sheets(DST_SHEET_NAME)
        Dim drg As Range: Set drg = dws.Range(DST_FIRST_CELL) _
            .Resize(rCount, srg.Columns.Count)
        
        srg.Copy Destination:=drg
        
        swb.Close SaveChanges:=False
        
        With drg
            ' Clear below.
            .Resize(dws.Rows.Count - .Row - rCount + 1).Offset(rCount).Clear
            ' Format.
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            '.EntireColumn.AutoFit
        End With
        
        'dwb.Close SaveChanges:=True
        
        Application.ScreenUpdating = True
        
        MsgBox "Raw data copied.", vbInformation
    
    End Sub