fermat543
02-20-2018, 08:39 AM
I am clearly missing something when it comes to ranges, copying and workbooks ... cannot seem to make this work. Simple task to copy a block of data from one spreadsheet to another. Any ideas?
'------------------------------------------------------------------------------
Private Sub mjsLoadOrigData()
'------------------------------------------------------------------------------
Dim RootFolder As String 'Where we start looking for the file
Dim FileChoice As Integer 'Which file was chosen
Dim FullName As String 'Full name of the file
Dim RangeText As String
Dim XLapp As Excel.Application 'Need a new instance of Excel
Dim SrcBook As Excel.Workbook 'This will be the Quote Workbook object
Dim ThisBook As Excel.Workbook 'This Rev Rec spreadsheet
RootFolder = "C:\Users\Admin\Desktop"
Set ThisBook = ThisWorkbook
On Error GoTo CLEANUP2
'------------------------------------------------
'Open the file to copy data from
'------------------------------------------------
Set XLapp = New Excel.Application
XLapp.Visible = True
XLapp.FileDialog(msoFileDialogOpen).InitialFileName = RootFolder
FileChoice = XLapp.FileDialog(msoFileDialogOpen).Show
If FileChoice = 0 Then GoTo CLEANUP2
FullName = XLapp.FileDialog(msoFileDialogOpen).SelectedItems(1)
Set SrcBook = XLapp.Workbooks.Open(FullName)
On Error GoTo 0
'---------------------------------------------
'work out the range and paste the data
'---------------------------------------------
RangeText = SrcBook.Worksheets("Original Data").Range("A1").End(xlDown).End(xlToRight).Address
RangeText = "A1:" & Replace(RangeText, "$", "", 1)
SrcBook.Worksheets("Original Data").Range(RangeText).Copy _
Destination:=ThisBook.Worksheets("Data").Range(RangeText)
CLEANUP2:
'------------------------------------------------
'lets close the file and release memory etc..
'------------------------------------------------
On Error Resume Next
SrcBook.Close savechanges:=False
XLapp.Quit
Set XLapp = Nothing
Set SrcBook = Nothing
On Error GoTo 0
End Sub
'------------------------------------------------------------------------------
Private Sub mjsLoadOrigData()
'------------------------------------------------------------------------------
Dim RootFolder As String 'Where we start looking for the file
Dim FileChoice As Integer 'Which file was chosen
Dim FullName As String 'Full name of the file
Dim RangeText As String
Dim XLapp As Excel.Application 'Need a new instance of Excel
Dim SrcBook As Excel.Workbook 'This will be the Quote Workbook object
Dim ThisBook As Excel.Workbook 'This Rev Rec spreadsheet
RootFolder = "C:\Users\Admin\Desktop"
Set ThisBook = ThisWorkbook
On Error GoTo CLEANUP2
'------------------------------------------------
'Open the file to copy data from
'------------------------------------------------
Set XLapp = New Excel.Application
XLapp.Visible = True
XLapp.FileDialog(msoFileDialogOpen).InitialFileName = RootFolder
FileChoice = XLapp.FileDialog(msoFileDialogOpen).Show
If FileChoice = 0 Then GoTo CLEANUP2
FullName = XLapp.FileDialog(msoFileDialogOpen).SelectedItems(1)
Set SrcBook = XLapp.Workbooks.Open(FullName)
On Error GoTo 0
'---------------------------------------------
'work out the range and paste the data
'---------------------------------------------
RangeText = SrcBook.Worksheets("Original Data").Range("A1").End(xlDown).End(xlToRight).Address
RangeText = "A1:" & Replace(RangeText, "$", "", 1)
SrcBook.Worksheets("Original Data").Range(RangeText).Copy _
Destination:=ThisBook.Worksheets("Data").Range(RangeText)
CLEANUP2:
'------------------------------------------------
'lets close the file and release memory etc..
'------------------------------------------------
On Error Resume Next
SrcBook.Close savechanges:=False
XLapp.Quit
Set XLapp = Nothing
Set SrcBook = Nothing
On Error GoTo 0
End Sub