Copy data and control error

[ashani]

Hi,

I wonder if someone could please guide me - I'm using the following Macro coding to copy data from one workbook to another - however the another workbook is shared across different campuses so if any other use in that workbook then the error message comes up. What I'm looking for is - if someone is in the other workbook then user receives the message pop up to say "Another user is in the workbook, would you like to save or wait" - If user select save then it saves as normal and if click retry and try again to copy the data over to another workbook and then save. Here's my current coding.

Many thanks in advance.

ub CopyToMI()
    Dim Cel As Range
    Dim wsc As Worksheet, wst As Worksheet
    Dim wbc As Workbook, wbt As Workbook
    Dim arrc, arrt
    Dim k&, j&, m&
    Dim i As Variant

    On Error GoTo myerror
    Set wbc = ThisWorkbook
    Set wsc = wbc.Worksheets("dashboard")
    arrc = wsc.[B8:D10]
    k = 1: m = 0
    ReDim arrt(1, UBound(arrc, 1) * (UBound(arrc, 2)))
    For i = 1 To UBound(arrc, 1)
        For j = 1 To UBound(arrc, 2)
            arrt(k, m + j) = arrc(i, j)
        Next j
        m = m + UBound(arrc, 2)
        
    Next i
    Application.ScreenUpdating = False
    Set wbt = Workbooks.Open("C:\Users\Desktop\Test.xlsx", ReadOnly:=False, Password:="abc")
    Set wst = wbt.Worksheets("Sheet1")
    i = Application.Match(UCase(wsc.[D3]), wst.[A1:A82], 0)
'Search Text Not Found
    If IsError(i) Then Err.Raise 744
    wst.Cells(CLng(i), 2).Resize(UBound(arrt, 1), UBound(arrt, 2)) = arrt

    wbt.Close True
    Set wbt = Nothing

myerror:
    If Not wbt Is Nothing Then wbt.Close False
    Application.ScreenUpdating = True
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Select Your Campus"
End Sub

 

[ashani]

hi everyone,

any possibilty to achieve the above objective ?

Many thanks,