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 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 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.
Related:

4 responses

TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
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

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
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
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
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.
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
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
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
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
Oct 24, 2017 at 10:51 AM
Thanks for your feedback Omchabria.