Copying data to an open file sheet from another

[rneilson52]

I am having an issue with an open file, selecting a second file and then copying data from a specific sheet in that second file, then closing that workbook and copying the data to the next blank row on a sheet in the first file. The code I have is

Sub Import_Data()
'
' Import_Data Macro
' Import from Manifest file
'

'
ThisWorkbook.Worksheets("Database").Select
ActiveSheet.Unprotect

Dim FileToOpen As Variant
Dim OpenBook As Workbook
Dim FolderPath As String

FolderPath = "C:\"
VBA.ChDir FolderPath


FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xlsm*),*xlsm*")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
Sheets("Reporting Data").Select
ActiveSheet.Unprotect
Range("A2:P250").Copy
ActiveSheet.Protect
OpenBook.Close False
End If
Application.ScreenUpdating = True
ThisWorkbook.Worksheets("Database").Select
ActiveSheet.Unprotect
NextRow = Range("A100000").End(xlUp).Row + 1
Range("A" & NextRow).Select.PasteSpecial xlPasteValues This is where I fall over with a runtime error 424

ActiveSheet.Protect

End Sub

Any help greatly appreciated

 

[eiloken]

I am having an issue with an open file, selecting a second file and then copying data from a specific sheet in that second file, then closing that workbook and copying the data to the next blank row on a sheet in the first file. The code I have is

Sub Import_Data()
'
' Import_Data Macro
' Import from Manifest file
'

'
ThisWorkbook.Worksheets("Database").Select
ActiveSheet.Unprotect

Dim FileToOpen As Variant
Dim OpenBook As Workbook
Dim FolderPath As String

FolderPath = "C:\"
VBA.ChDir FolderPath


FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xlsm*),*xlsm*")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
Sheets("Reporting Data").Select
ActiveSheet.Unprotect
Range("A2:P250").Copy
ActiveSheet.Protect
OpenBook.Close False
End If
Application.ScreenUpdating = True
ThisWorkbook.Worksheets("Database").Select
ActiveSheet.Unprotect
NextRow = Range("A100000").End(xlUp).Row + 1
Range("A" & NextRow).Select.PasteSpecial xlPasteValues This is where I fall over with a runtime error 424

ActiveSheet.Protect

End Sub

Any help greatly appreciated

try this:

Sub Import_Data()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook, OpenWs As Worksheet, thisWs As Worksheet
    Set thisWs = ThisWorkbook.Worksheets("Database")
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xlsm*),*xlsm*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        Set OpenWs = OpenBook.Sheets("Reporting Data")
        OpenWs.Unprotect
        thisWs.Unprotect
        OpenWs.Range("A2:P250").Copy
        NextRow = thisWs.Range("A100000").End(xlUp).Row + 1
        thisWs.Range("A" & NextRow).PasteSpecial xlPasteValues
        OpenWs.Protect
        thisWs.Protect
        OpenBook.Close False
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
    End If
End Sub

 

[rneilson52]

Fantastic - works a treat and thank you very much for your solution