How to copy range from variable named workbook to current workbook
Category: [Excel] Demo Available
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.
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.
See also: Index to Excel VBA Code and Index to Excel Freebies and Lesson 1 - Excel Fundamentals and Index to how to… providing a range of solutions and Index to new resources and reference sheets
See also:
| How to use VBA script to count files/subfolders using a range from WB for the root folder |
| How to add sequential numbers between values, within a range |
| How to locate numbers 1 to 10 in a range |
| How to loop through different ranges |
Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.