Multiple workbooks and the command button

lsarr

New member
Joined
Apr 10, 2014
Messages
1
Reaction score
0
Points
0
Below is the code I am currently using to update one worksheet to another. I would like to start updating WorkbookA to WorkbookB, I have a code to copy the informaiton but would like to update using the same command button, unsure of how to write that code, looking for help. Thanks!


Private Sub CommandButton1_Click()

Dim DateReceived As Date, PatientName As String, Plan As String, Region As Integer, Facility As String, Hospital As String
Worksheets("Main").Select
DateReceived = Range("B3")
PatientName = Range("C3")
Plan = Range("D3")
Region = Range("E3")
Facility = Range("F3")
Hospital = Range("G3")
Worksheets("Sub").Select
Worksheets("Sub").Range("B4").Select
If Worksheets("Sub").Range("B4").Offset(1, 0) <> "" Then
Worksheets("Sub").Range("B4").End(xlDown).Select
End If
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = DateReceived
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = PatientName
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Plan
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Region
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Facility
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Hospital
Worksheets("Main").Select
Worksheets("Main").Range("B3").Select
End Sub
 
Hi,

I modified your code. It should do the same as your original code.
It does not answer your question.
If you are updating the "Sub" sheet from another workbook
you will need for the code to open it get the data and then close it.
Can you be more specific as to your request.

Code:
Private Sub CommandButton1_Click()


Dim DateReceived As Date, PatientName As String, Plan As String, Region As Integer, Facility As String, Hospital As String
Dim lrow As Long '' used to get the last used row in sub sheet
Dim Mws As Worksheet
Set Mws = Sheets("Main")
Dim Sws As Worksheet
Set Sws = Sheets("Sub")
With Mws '' being command button on Main no need to activate it's already activate
'' It also appears you are just copying 1 row of data
'' so this will copy and paste to "Sub" sheet next empty row"
'' we add 1 to the row this give us the next empty row
'' we will see if "B3" is Sub sheet has data if it does we run this code
    If Sws.Range("B3") <> "" Then
        Mws.Range("B3:G3").Copy Destination:=Sws.Range("B3:G" & Sws.Range("B65536").End(xlUp).Row + 1)
    '' being we now where the data goes in the sub sheet no need to activate it'''
    Else
    ''' No data in B3 '' copy Main to it so we do not need the last row''
        Mws.Range("B3:G3").Copy Destination:=Sws.Range("B3:G3")
    End If
End With
End Sub
 
Back
Top