Macros | Multiple data entry and transfer data from sheet to sheet | Mimic database action

[bebongtheshark]

Hi everyone

I'd like to ask if it is possible to mimic actions similar to a database but only within the same workbook. If it is possible, I'd like to get a structure code for macros so that I can follow and imitate =) Here's my specs:

Here is Sheet 1

	Column A	Column B	Column C	Column D	Column E
Row 1	Name	Arthur McArthur Bennington (merged to Columns C and D)
Row 2	Age	25 (not merged
Row 3
Row 4	Ques 1	Y
Row 5	Ques 2	333.667
Row 6	Ques 3	N
Row 7	Ques 4	(^*^&$^##^#%
		THERE IS SOME FORM OF SUBMIT BUTTON HERE

<tbody>
</tbody>

Here is Sheet 2

	Column A	Column B	Column C	Column D	Column E	Column F	Column G
Row 1	No.	Name	Age	Q1	Q2	Q3	Q4
Row 2	1	Arthur McArthur Bennington	25	Y	333.667	N	(^*^&$^##^#%
Row 3	2	Kurt Cobain	22	N	15.67	N	*&^()^(%$(

<tbody>
</tbody>

The idea is that someone enters raw data or accomplishes Sheet 1 and presses submit button. That triggers copying of data to Sheet 2. Submit button also clears the data fields answered in Sheet 1 to enable next user to submit another set of data.

I think this is quite complex but I'm hoping someone can help me design or create an idea how to make this macro work =)

Best regards everyone! Thank you in advance for your help =D

 

[JLGWhiz]

Create a button from the forms toolbox and attach this macro. Copy the Macro to the standard code module1. This procedure assumes that Headers in column A of sheet 1 are permanent and that headers in Row 1 of sheet 2 are permanent, both are entered and formatted prior to running the procedure. Item numbers on sheet two will be assigned automatically as items are added.

[Code}
Sub sh1Tosh2()
Dim sh1 As Worksheet, sh2 As Worksheet, lr As Long, rng As Range
Set sh1 = Sheets(1) 'Edit sheet name
Set sh2 = Sheets(2) 'Edit sheet name
lr = sh1.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh1.Range("B2:B" & lr)
rng.Copy
sh2.Cells(Rows.Count, 2).End(xlUp)(2).PasteSpecial Transpose:=True
If Application.CountA(sh2.Range("A3:C3")) = 0 Then
sh2.Cells(Rows.Count, 1).End(xlUp)(2) = 1
Else
sh2.Cells(Rows.Count, 1).End(xlUp)(2) = sh2.Cells(Rows.Count, 1).End(xlUp).Value + 1
End If
End Sub
[/Code]

 

[JLGWhiz]

Sub sh1Tosh2()
Dim sh1 As Worksheet, sh2 As Worksheet, lr As Long, rng As Range
Set sh1 = Sheets(1) 'Edit sheet name
Set sh2 = Sheets(2) 'Edit sheet name
lr = sh1.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh1.Range("B2:B" & lr)
rng.Copy
sh2.Cells(Rows.Count, 2).End(xlUp)(2).PasteSpecial Transpose:=True
    If Application.CountA(sh2.Range("A3:C3")) = 0 Then
        sh2.Cells(Rows.Count, 1).End(xlUp)(2) = 1
    Else
        sh2.Cells(Rows.Count, 1).End(xlUp)(2) = sh2.Cells(Rows.Count, 1).End(xlUp).Value + 1
    End If
End Sub