excelvba

Copying between two different workbooks with VBA


I got a code to copy data from a closed workbook to another active workbook but I have a probelm in closing workbooks after runing the code I don't know how to fix it

my source Workbook is "Stop Work" sheet1 and the destination workbook is "AUTHS" and sheet name is "stop work" the code run smoothly but my probelm is that after runnig the code and copying the data my active workbook which I'm working on it "AUTHS" get closed and the source workbook which was closed get opened while i need the vice versa (to save and close "stop Work" and keep "AUTHS" open - I Have tried changing true and false but nothing done this is my code

Sub mycode()

Workbooks.Open Filename:="D:\Desktop\Stop Work.xlsm"
Worksheets("Sheet1").Cells.Select
Selection.Copy

Workbooks.Open Filename:="D:\Desktop\AUTHs.xlsm"
Worksheets("Stop Work").Cells.Select
Selection.PasteSpecial xlPasteAll             'xlPasteAll to paste everything
ActiveWorkbook.Save

ThisWorkbook.Close SaveChanges:=False        'to close the file
Workbooks("D:\Desktop\Stop Work.xlsm").Close SaveChanges:=True  'to close the file

End Sub



thank you in advance        

Solution

  • Copy from Closed Workbook

    Sub CopyFromClosedWorkbook()
        
        ' Reference the source objects.
        Dim swb As Workbook: Set swb = Workbooks.Open("D:\Desktop\Stop Work.xlsm")
        Dim sws As Worksheet: Set sws = swb.Sheets("Sheet1")
        Dim srg As Range:
        With sws.UsedRange
            Set srg = sws.Range("A1", .Cells(.Cells.CountLarge))
        End With
        
        ' Reference the destination objects.
        Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
        Dim dws As Worksheet: Set dws = dwb.Sheets("Stop Work")
        Dim dfcell As Range
        ' Either overwrite...
        dws.UsedRange.Clear ' clear existing data
        Set dfcell = dws.Range("A1")
        ' ... or append:
        'With dws.UsedRange
        '    Set dfcell = .Cells(1).EntireRow.Columns("A").Offset(.Rows.Count)
        'End With
        Dim drg As Range: Set drg = dfcell.Resize(srg.Rows.Count, srg.Columns.Count)
        
        ' Either copy values, formulas and formatting...
        srg.Copy Destination:=drg
        ' ... or copy only values:
        'drg.Value = srg.Value
        
        ' Close the source workbook.
        swb.Close SaveChanges:=False ' just read from
        
        ' Save the destination workbook.
        dwb.Save
        
        ' Inform.
        MsgBox "Data copied.", vbInformation
    
    End Sub