Referencing a workbook name which is always a temp file of different names

[gazmoz17]

Hi, I have a working script from here which works to a point after Ive saved a temp workbook exported from accountancy system to excel., giving it a filename to ref.

So need to change script slightly.

My workbook where I get the source data from changes as its always a differently named temp file e.g. tmp4313.xlsx

Need to change this "sas 30.09.xlsx" in my script to compensate for the temp file if possible save me saving this temp file each time.

This will be the only temp file open at the time of running the script.

Any help much appreciated.

ption Explicit

Sub Copy_Paste_Below_Last_Cell()
'Find the last used row in both sheets and copy and paste data below existing data.

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long

  'Set variables for copy and destination sheets
  Set wsCopy = Workbooks("sas 30.09.xlsx").Worksheets("SAS Fix")
  Set wsDest = Workbooks("Gareth's SAS Master.xlsm").Worksheets("2017 onwards")
    
  '1. Find last used row in the copy range based on data in column A
  lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
    
  '2. Find first blank row in the destination range based on data in column A
  'Offset property moves down 1 row
  lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row

  '3. Copy & Paste Data
  wsCopy.Range("A2:O" & lCopyLastRow).Copy _
    wsDest.Range("A" & lDestLastRow)
    
  'Optional - Select the destination sheet
  wsDest.Activate
 
End Sub

 

[Trebor76]

Hi gazmoz17,

Try this:

Option Explicit
Sub Copy_Paste_Below_Last_Cell()

    'Find the last used row in both sheets and copy and paste data below existing data.
    
    Dim wbCopy As Workbook
    Dim wsCopy As Worksheet
    Dim wsDest As Worksheet
    Dim lCopyLastRow As Long
    Dim lDestLastRow As Long
    
    'Set variables for copy and destination sheets
    For Each wbCopy In Workbooks
        If wbCopy.Name <> ThisWorkbook.Name And StrConv(Left(wbCopy.Name, 3), vbLowerCase) = "tmp" Then
            Exit For
        End If
    Next wbCopy
    If wbCopy Is Nothing Then
        MsgBox "There is no other workbook open in this session whose name starts with ""tmp"".", vbExclamation
        Exit Sub
    End If
    Set wsCopy = wbCopy.Worksheets("SAS Fix")
    Set wsDest = Workbooks("Gareth's SAS Master.xlsm").Worksheets("2017 onwards")
      
    '1. Find last used row in the copy range based on data in column A
    lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
      
    '2. Find first blank row in the destination range based on data in column A
    'Offset property moves down 1 row
    lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
    
    '3. Copy & Paste Data
    wsCopy.Range("A2:O" & lCopyLastRow).Copy _
      wsDest.Range("A" & lDestLastRow)
      
    'Optional - Select the destination sheet
    wsDest.Activate
 
End Sub

Regards,

Robert

 

[gazmoz17]

What a guy thanks Robert works perfect ?, really appricate that time saver. Being cheeky now but is there a way for the script to copy and paste only highlighted range in SAS Fix as an alternative to A2:O. Or complete existing range whatever column/row my data ends in "Sas fix" being copy and pasted.

Many Thanks
Gareth

 

[Trebor76]

Do you mean like this:

Option Explicit
Sub Copy_Paste_Below_Last_Cell()

    'Find the last used row in both sheets and copy and paste data below existing data.
    
    Dim wbCopy As Workbook
    Dim wsCopy As Worksheet
    Dim wsDest As Worksheet
    Dim lCopyLastRow As Long, lCopyLastCol As Long
    Dim lDestLastRow As Long
    
    Application.ScreenUpdating = False
    
    'Set variables for copy and destination sheets
    For Each wbCopy In Workbooks
        If wbCopy.Name <> ThisWorkbook.Name And StrConv(Left(wbCopy.Name, 3), vbLowerCase) = "tmp" Then
            Exit For
        End If
    Next wbCopy
    If wbCopy Is Nothing Then
        MsgBox "There is no other workbook open in this session whose name starts with ""tmp"".", vbExclamation
        Exit Sub
    End If
    Set wsCopy = wbCopy.Worksheets("SAS Fix")
    Set wsDest = Workbooks("Gareth's SAS Master.xlsm").Worksheets("2017 onwards")
    
    '1. Find the last row (in whatever column it resides in) and last column
    If WorksheetFunction.CountA(wsCopy.Cells) > 0 Then
        lCopyLastRow = wsCopy.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        lCopyLastCol = wsCopy.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    Else
        MsgBox "There is no data in tab """ & wsCopy.Name & """ to copy.", vbExclamation
        Exit Sub
    End If
      
    '2. Find first blank row in the destination range based on data in column A
    'Offset property moves down 1 row
    lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
    
    '3. Copy & Paste Data
    Range(wsCopy.Cells(2, 1), wsCopy.Cells(lCopyLastRow, lCopyLastCol)).Copy _
        wsDest.Range("A" & lDestLastRow)
      
    'Optional - Select the destination sheet
    wsDest.Activate
    
    Application.ScreenUpdating = True
 
End Sub

 

[gazmoz17]

Thats the jobby mate thank you. Huge time saver ?. Some times messing around with that first source data sheet.

 

[Trebor76]

Thanks for letting us know and you're welcome