Copying rows into different 2 different spreadsheets based on 2 colums

[N1x0N92]

Hi

First post so hopefully I can give enough information for someone to help me

Im trying to set up a spreadsheet that will allow a colleague to enter information on the MASTER that will then feed into other sheets.

The below a copy from the master sheet...…

Date Description Cost Centre Amount Reconciled 01/04/2019 Money in 1 Donations 100 Apr-19 02/04/2019 Money out 2 Donations -100 May-19 03/04/2019 Money in 2 Friends of School 50 Jun-19 04/04/2019 Money out 3 School Trips -50 Jul-19 05/04/2019 Money in 3 School Trips 70 Aug-19 06/04/2019 Money out 4 School Trips -70 Sep-19 07/04/2019 Money in 4 Donations Income 40 Oct-19 08/04/2019 Money out 5 Donations Expenditure -40 Nov-19 09/04/2019 Money in 5 School Trips 95 Dec-19 10/04/2019 Money out 6 School Trips -95 Jan-20 11/04/2019 Money in 6 Donations 45 Feb-20 12/04/2019 Money out 7 Donations -45 Mar-20 13/04/2019 Money in 7 School Trips 20 14/04/2019 Money out 8 School Trips -20 15/04/2019 Money in 8 Donations 10 16/04/2019 Money out 9 Donations -10 <tbody> </tbody> <strike></strike>
I then have a sheet for each Cost Centre and a sheet for reconciled for example (Donations and April 19) what I then need to happen is the whole row to be copied into the relevant cost centre and also the reconciled month. is this possible? Any help would be fantastic. Kind regards ​ <strike></strike>	<strike></strike>

<tbody>
</tbody>

 

[N1x0N92]

hi

"""Or do you want the one double clicked on just do nothing if it has already been copied over. """

the above would be perfect

kind regards
​

 

[My Aswer Is This]

Try this:
When you double click on column 3
That cell will be colored Red and the script continues.
If that cell is already colored Red the script will tell you that row has already been copied over and the script will stop and do nothing.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Modified  8/8/2019  3:41:50 AM  EDT
If Target.Column = 3 Then
Cancel = True
On Error GoTo M
If Target.Interior.Color = vbRed Then MsgBox "That row has already been copied" & vbNewLine & "I will stop this script": Exit Sub
Dim Lastrowc As Long
Dim ans As String
Dim Lastrowe As Long
ans = Format(Cells(Target.Row, "E"), "MMM-YY")
Lastrowc = Sheets(Cells(Target.Row, "C").Value).Cells(Rows.Count, "A").End(xlUp).Row + 1
Lastrowe = Sheets(ans).Cells(Rows.Count, "A").End(xlUp).Row + 1
Rows(Target.Row).Copy Sheets(Cells(Target.Row, "C").Value).Rows(Lastrowc)
Rows(Target.Row).Copy Sheets(ans).Rows(Lastrowe)
Target.Interior.Color = vbRed
End If
Exit Sub
M:
MsgBox "You do not have a sheet by that name"
End Sub

 

[N1x0N92]

Hi

this is brilliant!

i have another request, can the script stope copying after column F.

so when it copies the date into the new sheets it copies colums A to F but then leaves the data i have manaully keyed in the new spreadsheets after that?

Thanks in advance.

 

[My Aswer Is This]

Try this:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Modified  8/14/2019  1:09:20 PM  EDT
If Target.Column = 3 Then
Cancel = True
On Error GoTo M
If Target.Interior.Color = vbRed Then MsgBox "That row has already been copied" & vbNewLine & "I will stop this script": Exit Sub
Dim Lastrowc As Long
Dim ans As String
Dim Lastrowe As Long
ans = Format(Cells(Target.Row, "E"), "MMM-YY")
Lastrowc = Sheets(Cells(Target.Row, "C").Value).Cells(Rows.Count, "A").End(xlUp).Row + 1
Lastrowe = Sheets(ans).Cells(Rows.Count, "A").End(xlUp).Row + 1
Cells(Target.Row, 1).Resize(, 6).Copy Sheets(Cells(Target.Row, "C").Value).Cells(Lastrowc, 1)
Cells(Target.Row, 1).Resize(, 6).Copy Sheets(ans).Cells(Lastrowe, 1)
Target.Interior.Color = vbRed
End If
Exit Sub
M:
MsgBox "You do not have a sheet by that name"
End Sub