VBA for copying from data entry sheet to corresponding sheets

Solved/Closed
OMCHABRIA Posts 4 Registration date Monday October 9, 2017 Status Member Last seen October 24, 2017 - Updated on Oct 9, 2017 at 03:50 PM
TrowaD Posts 2913 Registration date Sunday September 12, 2010 Status Moderator Last seen November 21, 2022 - Oct 24, 2017 at 10:51 AM
Hi,

I am new to excel and would need some help. I wanted a vba for copying from data entry sheet to corresponding sheets automatically in the same workbook.

Thanks in Advance.

4 replies

TrowaD Posts 2913 Registration date Sunday September 12, 2010 Status Moderator Last seen November 21, 2022 541
Oct 9, 2017 at 11:49 AM
Hi Omchabria,

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Columns("E")) Is Nothing Then Exit Sub
Target.EntireRow.Copy _
Sheets(target.value).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End Sub


This is the basic code to do said request.

How it works:
When you confirm an entry (which will be a sheet name) in column E (as specified in the 2nd code line), that row will be copied to the corresponding sheet in the first available row.

How to use:
Right-click the entry sheets tab and select view code. Paste the code in the big white field.

Best regards,
Trowa

1
OMCHABRIA Posts 4 Registration date Monday October 9, 2017 Status Member Last seen October 24, 2017
Oct 10, 2017 at 03:21 AM
Hello Trowa D,

Thanks very much for your quick reply.

my exact query is :
DATA
SNO.BUS/WINGER DATE DETAILS AMT REMARKS
1 R-1 28-05-2016 WHEEL ALIGNMENT 550 APEX AUTOMOBILES
11 R-2 24-05-2016 ELECTRIC FITTING 268 PREMIER ELECTRICALS
30 R-7 05-01-2017 NEW BATTERY 5000 SRI LAXMI BATTERIES

I have a excel having around 125 sheets, sheets named as per 2nd coloumn(eg R1, R2, R7). Need the entries to be copied automatically in the corresponding sheets whenever i enter the data(main) sheet.

Would be thankful if you can help

Omchabria
0
TrowaD Posts 2913 Registration date Sunday September 12, 2010 Status Moderator Last seen November 21, 2022 541
Oct 10, 2017 at 11:00 AM
Hi Omchabria,

When you want to copy your row to the corresponding sheet when you enter/confirm the sheet name in column B then use:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Columns("B")) Is Nothing Then Exit Sub
Target.EntireRow.Copy _
Sheets(target.value).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End Sub


When you want this to happen when you enter the last data in the row, which is column F, right? Then use:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Columns("F")) Is Nothing Then Exit Sub
Target.EntireRow.Copy _
Sheets(Target.Offset(0, -4).Value).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End Sub


Best regards,
Trowa
0
OMCHABRIA Posts 4 Registration date Monday October 9, 2017 Status Member Last seen October 24, 2017
Oct 14, 2017 at 12:19 AM
Hi Trowa,

Thank you very much with the help, but I am facing a problem on the copied sheets. the old data is being replace by the new entry. I want the old data and the new data in the next line. Really apperiaciate your help

Thanks in advance.
0
TrowaD Posts 2913 Registration date Sunday September 12, 2010 Status Moderator Last seen November 21, 2022 541
Oct 16, 2017 at 11:19 AM
Hi Omchabria,

In the provided codes, column A is used to determine the last row used. When this column doesn't hold any data, then the row is presumed empty.

Let's take a look a the 4th code line:
Sheets(target.value).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

When you want the code to look at column B to determine the last used row, then we have to change the A to B. Now the copied row doesn't fit the destination, so we have to change the offset value from (1,0) to (1,-1). Which means 1 cell down and 1 cell to the left.

The 4th code line would then look like:
Sheets(target.value).Range("B" & Rows.Count).End(xlUp).Offset(1, -1)


Can you make it work now?

Best regards,
Trowa
0
OMCHABRIA Posts 4 Registration date Monday October 9, 2017 Status Member Last seen October 24, 2017
Oct 24, 2017 at 01:46 AM
Hello Trowa,

I sincerely thank your effort in helping me out with my problem.

Thanks very much and the problem is solved.

Regards.

Omchabria
0
TrowaD Posts 2913 Registration date Sunday September 12, 2010 Status Moderator Last seen November 21, 2022 541
Oct 24, 2017 at 10:51 AM
Thanks for your feedback Omchabria.
0