• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Macro Transfer Data to Another Sheet

Hello,
I have customer data in entryform sheet and I want to transfer this data to the database sheet by clicking SUBMIT button on the entryform sheet.

I have attached a sample form
 

Attachments

  • TransferData.xlsx
    14.4 KB · Views: 12
Here is some partial code. Based upon this code you should be able to copy the syntax and complete your needs.
Code:
Option Explicit

Sub trsfr()
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("entryform")
Set s2 = Sheets("database")
Dim lr As Long
lr = s2.Range("B" & Rows.Count).End(xlUp).Row
With s1
.Range("C2").Copy s2.Range("B" & lr + 1)
.Range("A6").Copy s2.Range("D" & lr + 1)
'continue to copy and paste using this example for the rest of your cells
.Range("C2").ClearContents
.Range("A6").ClearContents
'continue to clear contents for the remaining cells
End With
End Sub
 
Here you go ..

Code:
Sub Transfer_data()
Dim lastRow As Long, WsEntry As Worksheet, WsDb As Worksheet
Dim Cus_Found As Range

Set WsEntry = Sheets("entryform")
Set WsDb = Sheets("database")
Set Cus_Found = WsDb.Range("B:B").Find(WsEntry.Range("customerID").Value) ' to check customer id already entered in database sheet

With Application
    .ScreenUpdating = False
End With

    If IsEmpty(WsEntry.Range("customerID").Value) Then
        MsgBox "Please enter Customer ID.", vbCritical, "Customer Entry Form"
        Exit Sub
    End If

    If Cus_Found Is Nothing Then
  
        lastRow = WsDb.Range("B" & Rows.Count).End(xlUp).Row + 1 'Finds the last blank row
  
        WsDb.Range("B" & lastRow).Value = WsEntry.Range("customerID").Value
        WsDb.Range("D" & lastRow).Value = WsEntry.Range("FirstName").Value
        WsDb.Range("F" & lastRow).Value = WsEntry.Range("LastName").Value
        WsDb.Range("H" & lastRow).Value = WsEntry.Range("Mobile_No").Value
        WsDb.Range("J" & lastRow).Value = WsEntry.Range("Work_No").Value
        WsDb.Range("L" & lastRow).Value = WsEntry.Range("Email").Value
        WsDb.Range("N" & lastRow).Value = WsEntry.Range("Street_Address").Value
        WsDb.Range("P" & lastRow).Value = WsEntry.Range("City").Value
        WsDb.Range("R" & lastRow).Value = WsEntry.Range("State").Value
        WsDb.Range("T" & lastRow).Value = WsEntry.Range("Zip_Code").Value
      
        MsgBox "Customer ID successfully updated in database.", , "Customer Entry Form"
    Else
        MsgBox "Customer ID already captured.", , "Customer Entry Form"
    End If
  
    ' clear the form for next entry
    WsEntry.Range("customerID").ClearContents
    WsEntry.Range("FirstName").ClearContents
    WsEntry.Range("LastName").ClearContents
    WsEntry.Range("Mobile_No").ClearContents
    WsEntry.Range("Work_No").ClearContents
    WsEntry.Range("Email").ClearContents
    WsEntry.Range("Street_Address").ClearContents
    WsEntry.Range("City").ClearContents
    WsEntry.Range("State").ClearContents
    WsEntry.Range("Zip_Code").ClearContents
  
    With Application
        .ScreenUpdating = True
    End With

End Sub
 

Attachments

  • TransferData.xlsm
    23.5 KB · Views: 3
Hi,
I hope you wanted to keep updating the data to database for every entry in entryform.

Here you go ..

Code:
Sub Transfer_data()
Dim lastRow As Long, WsEntry As Worksheet, WsDb As Worksheet
Dim Cus_Found As Range

Set WsEntry = Sheets("entryform")
Set WsDb = Sheets("database")
Set Cus_Found = WsDb.Range("B:B").Find(WsEntry.Range("customerID").Value) ' to check customer id already entered in database sheet

With Application
    .ScreenUpdating = False
End With

    If IsEmpty(WsEntry.Range("customerID").Value) Then
        MsgBox "Please enter Customer ID.", vbCritical, "Customer Entry Form"
        Exit Sub
    End If

    If Cus_Found Is Nothing Then

        lastRow = WsDb.Range("B" & Rows.Count).End(xlUp).Row + 1 'Finds the last blank row

        WsDb.Range("B" & lastRow).Value = WsEntry.Range("customerID").Value
        WsDb.Range("D" & lastRow).Value = WsEntry.Range("FirstName").Value
        WsDb.Range("F" & lastRow).Value = WsEntry.Range("LastName").Value
        WsDb.Range("H" & lastRow).Value = WsEntry.Range("Mobile_No").Value
        WsDb.Range("J" & lastRow).Value = WsEntry.Range("Work_No").Value
        WsDb.Range("L" & lastRow).Value = WsEntry.Range("Email").Value
        WsDb.Range("N" & lastRow).Value = WsEntry.Range("Street_Address").Value
        WsDb.Range("P" & lastRow).Value = WsEntry.Range("City").Value
        WsDb.Range("R" & lastRow).Value = WsEntry.Range("State").Value
        WsDb.Range("T" & lastRow).Value = WsEntry.Range("Zip_Code").Value
   
        MsgBox "Customer ID successfully updated in database.", , "Customer Entry Form"
    Else
        MsgBox "Customer ID already captured.", , "Customer Entry Form"
    End If

    ' clear the form for next entry
    WsEntry.Range("customerID").ClearContents
    WsEntry.Range("FirstName").ClearContents
    WsEntry.Range("LastName").ClearContents
    WsEntry.Range("Mobile_No").ClearContents
    WsEntry.Range("Work_No").ClearContents
    WsEntry.Range("Email").ClearContents
    WsEntry.Range("Street_Address").ClearContents
    WsEntry.Range("City").ClearContents
    WsEntry.Range("State").ClearContents
    WsEntry.Range("Zip_Code").ClearContents

    With Application
        .ScreenUpdating = True
    End With

End Sub
Here you go ..

Code:
Sub Transfer_data()
Dim lastRow As Long, WsEntry As Worksheet, WsDb As Worksheet
Dim Cus_Found As Range

Set WsEntry = Sheets("entryform")
Set WsDb = Sheets("database")
Set Cus_Found = WsDb.Range("B:B").Find(WsEntry.Range("customerID").Value) ' to check customer id already entered in database sheet

With Application
    .ScreenUpdating = False
End With

    If IsEmpty(WsEntry.Range("customerID").Value) Then
        MsgBox "Please enter Customer ID.", vbCritical, "Customer Entry Form"
        Exit Sub
    End If

    If Cus_Found Is Nothing Then

        lastRow = WsDb.Range("B" & Rows.Count).End(xlUp).Row + 1 'Finds the last blank row

        WsDb.Range("B" & lastRow).Value = WsEntry.Range("customerID").Value
        WsDb.Range("D" & lastRow).Value = WsEntry.Range("FirstName").Value
        WsDb.Range("F" & lastRow).Value = WsEntry.Range("LastName").Value
        WsDb.Range("H" & lastRow).Value = WsEntry.Range("Mobile_No").Value
        WsDb.Range("J" & lastRow).Value = WsEntry.Range("Work_No").Value
        WsDb.Range("L" & lastRow).Value = WsEntry.Range("Email").Value
        WsDb.Range("N" & lastRow).Value = WsEntry.Range("Street_Address").Value
        WsDb.Range("P" & lastRow).Value = WsEntry.Range("City").Value
        WsDb.Range("R" & lastRow).Value = WsEntry.Range("State").Value
        WsDb.Range("T" & lastRow).Value = WsEntry.Range("Zip_Code").Value
    
        MsgBox "Customer ID successfully updated in database.", , "Customer Entry Form"
    Else
        MsgBox "Customer ID already captured.", , "Customer Entry Form"
    End If

    ' clear the form for next entry
    WsEntry.Range("customerID").ClearContents
    WsEntry.Range("FirstName").ClearContents
    WsEntry.Range("LastName").ClearContents
    WsEntry.Range("Mobile_No").ClearContents
    WsEntry.Range("Work_No").ClearContents
    WsEntry.Range("Email").ClearContents
    WsEntry.Range("Street_Address").ClearContents
    WsEntry.Range("City").ClearContents
    WsEntry.Range("State").ClearContents
    WsEntry.Range("Zip_Code").ClearContents

    With Application
        .ScreenUpdating = True
    End With

End Sub


Thanks
Here you go ..

Code:
Sub Transfer_data()
Dim lastRow As Long, WsEntry As Worksheet, WsDb As Worksheet
Dim Cus_Found As Range

Set WsEntry = Sheets("entryform")
Set WsDb = Sheets("database")
Set Cus_Found = WsDb.Range("B:B").Find(WsEntry.Range("customerID").Value) ' to check customer id already entered in database sheet

With Application
    .ScreenUpdating = False
End With

    If IsEmpty(WsEntry.Range("customerID").Value) Then
        MsgBox "Please enter Customer ID.", vbCritical, "Customer Entry Form"
        Exit Sub
    End If

    If Cus_Found Is Nothing Then
 
        lastRow = WsDb.Range("B" & Rows.Count).End(xlUp).Row + 1 'Finds the last blank row
 
        WsDb.Range("B" & lastRow).Value = WsEntry.Range("customerID").Value
        WsDb.Range("D" & lastRow).Value = WsEntry.Range("FirstName").Value
        WsDb.Range("F" & lastRow).Value = WsEntry.Range("LastName").Value
        WsDb.Range("H" & lastRow).Value = WsEntry.Range("Mobile_No").Value
        WsDb.Range("J" & lastRow).Value = WsEntry.Range("Work_No").Value
        WsDb.Range("L" & lastRow).Value = WsEntry.Range("Email").Value
        WsDb.Range("N" & lastRow).Value = WsEntry.Range("Street_Address").Value
        WsDb.Range("P" & lastRow).Value = WsEntry.Range("City").Value
        WsDb.Range("R" & lastRow).Value = WsEntry.Range("State").Value
        WsDb.Range("T" & lastRow).Value = WsEntry.Range("Zip_Code").Value
     
        MsgBox "Customer ID successfully updated in database.", , "Customer Entry Form"
    Else
        MsgBox "Customer ID already captured.", , "Customer Entry Form"
    End If
 
    ' clear the form for next entry
    WsEntry.Range("customerID").ClearContents
    WsEntry.Range("FirstName").ClearContents
    WsEntry.Range("LastName").ClearContents
    WsEntry.Range("Mobile_No").ClearContents
    WsEntry.Range("Work_No").ClearContents
    WsEntry.Range("Email").ClearContents
    WsEntry.Range("Street_Address").ClearContents
    WsEntry.Range("City").ClearContents
    WsEntry.Range("State").ClearContents
    WsEntry.Range("Zip_Code").ClearContents
 
    With Application
        .ScreenUpdating = True
    End With

End Sub


Thanks Thangavel.
 
Back
Top