Copy & Paste to closed workbook in another folder

[johnsonk]

I have a little issue if you could help I copy and paste from one workbook to another with the code below which works fine as long as both workbooks are in the same folder and both open, what I would like to do is have the PriceSheet workbook in another folder and be able paste its data in to the closed DataBase workbook which is password protected so I would need it to unprotect then protect again.

Sub Clear_Existing_Data_Before_Paste()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Set wsCopy = Workbooks("PriceSheet.xls").Worksheets("ALL")
Set wsDest = Workbooks("DataBase.xls").Worksheets("ALL")

'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. Clear contents of existing data range
wsDest.Range("A2:S" & lDestLastRow).ClearContents
'4. Copy & Paste Data
wsCopy.Range("A2:S" & lCopyLastRow).Copy _
wsDest.Range("A2")
End Sub

Regards

 

[dmt32]

Hi,
untested but try this update to your code & see if does what you want

Sub Clear_Existing_Data_Before_Paste()
    Dim wsCopy As Worksheet
    Dim wbDest As Workbook
    Dim lCopyLastRow As Long, lDestLastRow As Long
    Dim FileName As String, OpenPassword As String, wsPassword As String

'******************************************************************************************************
'********************************************SETTINGS**************************************************
'REQUIRED - specify the PATH & File Name
    FileName = "C:\MyDocuments\MyDatabase\Database.xlsx"
    
'OPTIONAL - enter password to OPEN workbook
    OpenPassword = ""
'OPTIONAL - enter password to UNPROTECT database worksheet
    wsPassword = ""
    
'*****************************************************************************************************
    
    On Error GoTo myerror
    Set wsCopy = ThisWorkbook.Worksheets("ALL")
'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
    
    Application.ScreenUpdating = False
    Set wbDest = Workbooks.Open(FileName, UpdateLinks:=False, ReadOnly:=False, Password:=OpenPassword)
    
    With wbDest.Worksheets("ALL")
        .Unprotect wsPassword
'2. Find first blank row in the destination range based on data in column A
'Offset property moves down 1 row
        lDestLastRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Row
'3. Clear contents of existing data range
        .Range("A2:S" & lDestLastRow).ClearContents
'4. Copy & Paste Data
        wsCopy.Range("A2:S" & lCopyLastRow).Copy .Range("A2")
'protect sheet (optional)
       If Len(wsPassword) > 0 Then .Protect wsPassword
    End With
    
'5. Close & Save changes
    wbDest.Close True
    Set wbDest = Nothing
    
    MsgBox "Database Updated", 64, "Updated"
    
'if things go wrong, inform user
myerror:
'ensure workbook is closed
    If Not wbDest Is Nothing Then wbDest.Close False
    Application.ScreenUpdating = True
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Ensure that you change the values in settings section as required

Dave

 

[johnsonk]

Dave, That works perfect thank you so much. ?

 

[dmt32]

Dave, That works perfect thank you so much. ?

I do surprise myself sometimes! Glad update does what you want
Many thanks for feedback

Dave