VBA code to copy and paste to specific worksheet/columns

[K_Stevs1]

Hi I am have created a form in excel.

What I need help with is creating a code to copy and the paste the data into a specific worksheet and then the data into specific columns, on the next empty row.

Pictures of the excel attached.

In the form:
The person selects the type (which is one of the other 2 worksheets) - Cell C5
Then selects the Team (same on both tabs, anonymised for this purpose as (a, b, c ...)) - Cell F5
Then inputs the date of collection - Cell G5
Then in Cell C8 to C19 inputs the figure.

I want the data in to be copied into the columns in either Generic or Flying Start which ever is chosen in Cell C5,

I then need the data in Cells C8 to C19 to go into the column of the team selected in Cell F5.

I need the information in column A & B to go into the same column each time.

Is there a way to code this or am I better off trying a different method.

I really appropriate any help with this.

Many thanks

KS

 

[mumps]

It is hard to work with pictures. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach screenshot (not pictures) of your sheets. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[K_Stevs1]

It is hard to work with pictures. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach screenshot (not pictures) of your sheets. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

sorry not used this before, if it not correct I will try dropbox.

Test Form.xlsx
	C
29
Form

Test Form.xlsx
	A	B	C	D	E	F	G	H
1	Date	Case Type	a	b	c	d	e	f
2	Apr-21	U	2549	1311	1550	1050	651	918
3	Apr-21	E	149	41	93	104	73	54
4	Apr-21	I	110	13	47	33	27	42
5	Apr-21	LAC	22	19	15	11	8	8
6	Apr-21	CPR	9	5	2	8	2	6
7	Apr-21	CASPs	10	4	11	4	2	8
8	Apr-21	E (4-5 YRS)	18	9	19	24	9	12
9	Apr-21	I (4-5 YRS)	17	0	7	5	0	9
10	Apr-21	MARFs	0	0	0	3	0	0
11	Apr-21	MARACs	0	0	0	0	0	0
12	Apr-21	Referrals	0	0	0	0	0	0
13	Apr-21	Movements In	0	0	0	16	0	0
14	May-21	U	2059	1236	1454	1052	795	978
Generic

Test Form.xlsx
	A	B	C	D	E	F	G	H	I
1	Date	Case Type	a	b	c	d	e	f	H
2	Apr-21	U	258	155	487	205	163	363	0
3	Apr-21	E	62	55	135	67	188	135	0
4	Apr-21	I	153	1	186	85	72	59	0
5	Apr-21	LAC	6	1	13	6	4	10	0
6	Apr-21	CPR	5	3	2	10	8	5	0
7	Apr-21	CASPs	15	4	20	0	7	2	0
8	Apr-21	E (4-5 YRS)	18	0	36	18	28	32	0
FS

 

[K_Stevs1]

Test Form.xlsx
	B	C	D	E	F	G	H	I	J
1	Test Data
2
3
4
5	Case Type			Team			Date	1/1/22
6
7	Case Type	Number of cases
8	E
9	I
10	U
11	LAC
12	CPR
13	CASPs
14	E (4-5 YRS)
15	I (4-5 YRS)
16	MARFs
17	MARACs
18	Referrals
19	Movements In
20
Form

Cells with Data Validation
Cell	Allow	Criteria
C5	List	Generic, Flying Start
I5	Date	between 01/01/1900 and 01/12/5000
F5	List	='Team Lists'!$A$2:$A$9

sorry not used this before, if it not correct I will try dropbox.

Test Form.xlsx
	C
29
Form

Test Form.xlsx
	A	B	C	D	E	F	G	H
1	Date	Case Type	a	b	c	d	e	f
2	Apr-21	U	2549	1311	1550	1050	651	918
3	Apr-21	E	149	41	93	104	73	54
4	Apr-21	I	110	13	47	33	27	42
5	Apr-21	LAC	22	19	15	11	8	8
6	Apr-21	CPR	9	5	2	8	2	6
7	Apr-21	CASPs	10	4	11	4	2	8
8	Apr-21	E (4-5 YRS)	18	9	19	24	9	12
9	Apr-21	I (4-5 YRS)	17	0	7	5	0	9
10	Apr-21	MARFs	0	0	0	3	0	0
11	Apr-21	MARACs	0	0	0	0	0	0
12	Apr-21	Referrals	0	0	0	0	0	0
13	Apr-21	Movements In	0	0	0	16	0	0
14	May-21	U	2059	1236	1454	1052	795	978
Generic

Test Form.xlsx
	A	B	C	D	E	F	G	H	I
1	Date	Case Type	a	b	c	d	e	f	H
2	Apr-21	U	258	155	487	205	163	363	0
3	Apr-21	E	62	55	135	67	188	135	0
4	Apr-21	I	153	1	186	85	72	59	0
5	Apr-21	LAC	6	1	13	6	4	10	0
6	Apr-21	CPR	5	3	2	10	8	5	0
7	Apr-21	CASPs	15	4	20	0	7	2	0
8	Apr-21	E (4-5 YRS)	18	0	36	18	28	32	0
FS

 

[mumps]

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, team As Range, lRow As Long
    Set srcWS = Sheets("Form")
    lRow = Range("C" & Rows.Count).End(xlUp).Row
    Set team = Sheets(Range("C5").Value).Rows(1).Find(Range("F5").Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not team Is Nothing Then
        With Sheets(Range("C5").Value)
            .Range("A2").Resize(lRow - 7).Value = Range("H5")
            .Range("B2").Resize(lRow - 7).Value = Range("A8").Resize(lRow - 7).Value
            .Cells(2, team.Column).Resize(lRow - 7).Value = Range("C8").Resize(lRow - 7).Value
        End With
    Else
        MsgBox ("Team not found.")
    End If
    Application.ScreenUpdating = True
End Sub

 

[K_Stevs1]

Than

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, team As Range, lRow As Long
    Set srcWS = Sheets("Form")
    lRow = Range("C" & Rows.Count).End(xlUp).Row
    Set team = Sheets(Range("C5").Value).Rows(1).Find(Range("F5").Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not team Is Nothing Then
        With Sheets(Range("C5").Value)
            .Range("A2").Resize(lRow - 7).Value = Range("H5")
            .Range("B2").Resize(lRow - 7).Value = Range("A8").Resize(lRow - 7).Value
            .Cells(2, team.Column).Resize(lRow - 7).Value = Range("C8").Resize(lRow - 7).Value
        End With
    Else
        MsgBox ("Team not found.")
    End If
    Application.ScreenUpdating = True
End Sub

Thank you I really appreciate your help, this works lovely, just one more question if you don't mind, how do I get the data to go to next empty row, of the data already submitted? instead of the top.

 

[mumps]

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, team As Range, lRow As Long, lRow2 As Long
    Set srcWS = Sheets("Form")
    lRow = Range("C" & Rows.Count).End(xlUp).Row
    Set team = Sheets(Range("C5").Value).Rows(1).Find(Range("F5").Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not team Is Nothing Then
        With Sheets(Range("C5").Value)
            lRow2 = .Range("A" & .Rows.Count).End(xlUp).Row + 1
            .Range("A" & lRow2).Resize(lRow - 7).Value = Range("H5")
            .Range("B" & lRow2).Resize(lRow - 7).Value = Range("A8").Resize(lRow - 7).Value
            .Cells(lRow2, team.Column).Resize(lRow - 7).Value = Range("C8").Resize(lRow - 7).Value
        End With
    Else
        MsgBox ("Team not found.")
    End If
    Application.ScreenUpdating = True
End Sub

 

[K_Stevs1]

Thank you so much, that works just as I needed.

 

[mumps]

You are very welcome.

 

[K_Stevs1]

Thank you so much, that works just as I needed.

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, team As Range, lRow As Long, lRow2 As Long
    Set srcWS = Sheets("Form")
    lRow = Range("C" & Rows.Count).End(xlUp).Row
    Set team = Sheets(Range("C5").Value).Rows(1).Find(Range("F5").Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not team Is Nothing Then
        With Sheets(Range("C5").Value)
            lRow2 = .Range("A" & .Rows.Count).End(xlUp).Row + 1
            .Range("A" & lRow2).Resize(lRow - 7).Value = Range("H5")
            .Range("B" & lRow2).Resize(lRow - 7).Value = Range("A8").Resize(lRow - 7).Value
            .Cells(lRow2, team.Column).Resize(lRow - 7).Value = Range("C8").Resize(lRow - 7).Value
        End With
    Else
        MsgBox ("Team not found.")
    End If
    Application.ScreenUpdating = True
End Sub