How to Copy range from variable named workbook to Current workBook

How to copy range from variable named workbook to current workbook

Requirement:

The user has two file in same Directory. One is The Converter.xlsm and the other one the user received every day through email. The name of the file and worksheet is variable.

The user wants to copy data from that variable workbook, range ("A5:J5") till last but one row to the Convert.xlsm, worksheet ("Sheet1") from A4.

https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/150069-copy-range-from-variable-named-workbook-to-current-workbook

Solution:

Code:

Sub Main()
  Dim sWB As String, wb As Workbook, tf As Boolean, r as Range
  
  'Open the Variable Workbook if not open and set reference.
  sWB = FileOpen(ThisWorkbook.Path)
  tf = IsWorkbookOpen(sWB)
  If Not tf Then
    Set wb = Workbooks.Open(sWB, ReadOnly:=True)
    Else
    Set wb = Workbooks(sWB)
  End If
  
  'Exit if Sheet1 does not exist in Variable workbook.
  If Not WorkSheetExists("Sheet1", wb.Name) Then
    MsgBox "Sheet1 does not exist in: " & vbLf & wb.Name, vbCritical, "Macro Ending"
    GoTo TheEnd
  End If
  
  'Set and copy the range from Variable workbook and paste to ThisWorkbook.
  With wb.Worksheets("Sheet1")
    Set r = .Range("A5:J" & .Cells(.Rows.Count, "A").End(xlUp).Row - 1)
    r.Copy ThisWorkbook.Worksheets("Sheet1").Range("A4")
  End With
  
TheEnd:
  If Not tf Then wb.Close False
End Sub

'https://msdn.microsoft.com/en-us/library/office/aa219834(v=office.11).aspx
Function FileOpen(initialFilename As String) As String
  With Application.FileDialog(msoFileDialogOpen)
    .ButtonName = "&Open"
    .initialFilename = initialFilename
    'Change the contents of the Files of Type list.
        'Empty the list by clearing the FileDialogFilters collection.
        .Filters.Clear

        'Add a filter that includes all files.
    .Filters.Add "All files", "*.*"
    '.Filters.Add "Excel (*.xls)", "*.xls", 1
    .Filters.Add "Excel", "*.xls; *.xlsx; *.xlsm", 1
    .Title = "File Open"
    .AllowMultiSelect = False
    If .Show = -1 Then FileOpen = .SelectedItems(1)
  End With
End Function

Function IsWorkbookOpen(stName As String) As Boolean
    Dim Wkb As Workbook
    On Error Resume Next ' In Case it isn't Open
    Set Wkb = Workbooks(stName)
    If Not Wkb Is Nothing Then IsWorkbookOpen = True
    'Boolean Function assumed To be False unless Set To True
End Function

 'WorkSheetExists in a workbook:
Function WorkSheetExists(sWorkSheet As String, Optional sWorkbook As String = "") As Boolean
    Dim ws As Worksheet, wb As Workbook
    On Error GoTo notExists
    If sWorkbook = "" Then
      Set wb = ActiveWorkbook
      Else
      Set wb = Workbooks(sWorkbook) 'sWorkbook must be open already.  e.g. ken.xlsm, not x:\ken.xlsm.
    End If
    Set ws = wb.Worksheets(sWorkSheet)
    WorkSheetExists = True
    Exit Function
notExists:
    WorkSheetExists = False
End Function

Obtained from the OzGrid Help Forum.

Solution provided by Kenneth Hobson.