<VBA> Copy rows to multiple worksheets based on a condition

[Nixchamberlain]

[h=2]Hello,[/h]

I'm new here but I've been browsing the posts for quite a long time studying the MS Excel. I've found many posts similar to my problem, but none which seem to answer it quite right, there is always something slightly different, so I am hoping that someone can help.

I have 4 worksheets in my file named in order: Data, Designer, Production & Installer.

What I would like is a marco that would automatically copy an entire row to worksheet with the same name if text in column E matches that name. E.g. Designer selected in cell E2, then copies whole row to Designer sheet.

there are also additional columns in the other sheets, which come after the columns from the data sheet. these all have formulas in them, which would use the copied data.

Is this possible?

Any help would be appreciated. Many thanks
​

 

[My Aswer Is This]

We need to know the name of the sheet with your data
And when you say:
I would like is a marco that would automatically copy an entire row to worksheet with the same name if text in column E matches that name


Generally speaking nothing happens in Excel automatically. Are you saying when you enter a sheet name in column "E" you want the script to run and copy that row into the sheet with the name you just entered into column 'E"

And if we copy the entire row into the other sheet what row on the other sheet do we copy it to?

And if we copy the entire row to the other sheet we will over write any formulas in the row on the other sheet.

Or do you just want to copy over columns A to G for example.

Provide these details and maybe I can help you.

 

[Nixchamberlain]

We need to know the name of the sheet with your data
And when you say:
I would like is a marco that would automatically copy an entire row to worksheet with the same name if text in column E matches that name


Generally speaking nothing happens in Excel automatically. Are you saying when you enter a sheet name in column "E" you want the script to run and copy that row into the sheet with the name you just entered into column 'E"

And if we copy the entire row into the other sheet what row on the other sheet do we copy it to?

And if we copy the entire row to the other sheet we will over write any formulas in the row on the other sheet.

Or do you just want to copy over columns A to G for example.

Provide these details and maybe I can help you.

Apologies - the name of the sheet which the data is coming from is 'Data'. Yes you are correct, I need a script to run & copy columns A to E from that row when the sheet name is entered into column E. Does this make sense?

 

[frank_AL]

Nixchamberlain shared his file with me and I developed this code which he has confirmed is working as expected.
I added the Macro Option to allow the user to execute the Macro by pressing CTRL-q.

Regarding his request to copy formulas. Since the 'copy to' worksheets already had the required formulas, when a new row of data was copied the formulas automatically extended to the new row of data.

Option Explicit
Sub CopyDataToSheets()
Dim copyfromws As Worksheet
Dim copytows As Worksheet
Dim cfrng As Range
Dim ctrng As Range
Dim cflr As Long
Dim ctlr As Long
Dim i As Long
Dim currval As String


Set copyfromws = Sheets("Data")
cflr = copyfromws.Cells(Rows.Count, "B").End(xlUp).Row
    
'   Copy Row of Data to Specific Worksheet based on value in Column E
'   Existing Formulas in Columns F through H or J are automatically extended to the new row of data
For i = 2 To cflr
    currval = copyfromws.Cells(i, 5).Value
    Set copytows = Sheets(currval)
    ctlr = copytows.Cells(Rows.Count, "B").End(xlUp).Row + 1
    Set cfrng = copyfromws.Range("A" & i & ":E" & i)
    Set ctrng = copytows.Range("A" & ctlr & ":E" & ctlr)
    ctrng.Value = cfrng.Value
Next


End Sub

 

[Nixchamberlain]

Thanks for your help Frank, this does work perfectly.

 

[Nixchamberlain]

Hi My Aswer Is This, my issue has been solved now, but I will bear what you asked in mind and make sure I give more detail next time I post a query. many thanks

 

[Peter_SSs]

... I will bear what you asked in mind ...

Nixchamberlain shared his file with me ...

Please both bear in mind #4 of the Forum Rules. Files should not be shared privately. There are a number of tools to post small screen shots (see link in my signature block below) but if it does become necessary to actually share a file, it should be done by a public site so that all forum users can be aware of it.

 

[frank_AL]

My apology, it won't happen again!

 

[Peter_SSs]

My apology, it won't happen again!

Thanks for the confirmation.

 

[BABU Baru]

Nixchamberlain shared his file with me and I developed this code which he has confirmed is working as expected.
I added the Macro Option to allow the user to execute the Macro by pressing CTRL-q.

Regarding his request to copy formulas. Since the 'copy to' worksheets already had the required formulas, when a new row of data was copied the formulas automatically extended to the new row of data.

Option Explicit
Sub CopyDataToSheets()
Dim copyfromws As Worksheet
Dim copytows As Worksheet
Dim cfrng As Range
Dim ctrng As Range
Dim cflr As Long
Dim ctlr As Long
Dim i As Long
Dim currval As String


Set copyfromws = Sheets("Data")
cflr = copyfromws.Cells(Rows.Count, "B").End(xlUp).Row
   
'   Copy Row of Data to Specific Worksheet based on value in Column E
'   Existing Formulas in Columns F through H or J are automatically extended to the new row of data
For i = 2 To cflr
    currval = copyfromws.Cells(i, 5).Value
    Set copytows = Sheets(currval)
    ctlr = copytows.Cells(Rows.Count, "B").End(xlUp).Row + 1
    Set cfrng = copyfromws.Range("A" & i & ":E" & i)
    Set ctrng = copytows.Range("A" & ctlr & ":E" & ctlr)
    ctrng.Value = cfrng.Value
Next


End Sub

This code is working but I want when I run macro next time, It should transfer only new data below the exiting data in the copy to sheets.
I also I want to keep all data in Master sheet named "Data".
Can any expert help to change this VBA accordingly?
Thank you so much.