Data TransfferingClosed

Question

Good Morning.  I am new to the forum thing so any help would be great.  I am not sure if this is possible but I am looking to see if I can automatically get data I enter on a spreadsheet to transfer to the appropriate tab in the same workbook. I have a list of employees and their stats. They come to me alphabetically and I enter all the information on the main page and then I need to move to the correct location where the employee is. So wondering if there is a formula or short cut instead of copying and pasting all the information every day?  Thank you in advance for your time and knowledge.

Stacy

vcoolio · Answer

Hello Stacy,

If I have understood you correctly, then the following code may be able to do what you would like:-

Sub TransferIt()
Application.ScreenUpdating = False
Dim lRow As Long
Sheets("Input").Select
lRow = Range("A" & Rows.Count).End(xlUp).Row

For Each Cell In Range("A2:A" & lRow)
    If Cell = 1 Then
    Range(Cells(Cell.Row, "A"), Cells(Cell.Row, "G")).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    
    ElseIf Cell = 2 Then
    Range(Cells(Cell.Row, "A"), Cells(Cell.Row, "G")).Copy Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    
    ElseIf Cell = 3 Then
    Range(Cells(Cell.Row, "A"), Cells(Cell.Row, "G")).Copy Sheets("Sheet4").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    
    ElseIf Cell = 4 Then
    Range(Cells(Cell.Row, "A"), Cells(Cell.Row, "G")).Copy Sheets("Sheet5").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    
    ElseIf Cell = 5 Then
    Range(Cells(Cell.Row, "A"), Cells(Cell.Row, "G")).Copy Sheets("Sheet6").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    
    ElseIf Cell = 6 Then
    Range(Cells(Cell.Row, "A"), Cells(Cell.Row, "G")).Copy Sheets("Sheet7").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    
    ElseIf Cell = 7 Then
    Range(Cells(Cell.Row, "A"), Cells(Cell.Row, "G")).Copy Sheets("Sheet8").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    
    ElseIf Cell = 8 Then
    Range(Cells(Cell.Row, "A"), Cells(Cell.Row, "G")).Copy Sheets("Sheet9").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    
    ElseIf Cell = 9 Then
    Range(Cells(Cell.Row, "A"), Cells(Cell.Row, "G")).Copy Sheet("Sheet10").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    
    End If
 
Next Cell

Sheets("Input").Range("A2:G" & Rows.Count).ClearContents
MsgBox "Data transfer completed!", vbExclamation
Application.ScreenUpdating = True

End Sub

I have named Sheet1 "Input" as this is where I assume you would enter your data. The code will transfer each row of data from Columns A - G but this can be expanded or contracted to suit your needs. I have also allowed for nine employee sheets in the code just as an example of what happens on transfer. You will need to change the sheet names to that of your employees in the code (e.g. change Sheet2 to "Bob" etc.)

To simplify the code a little, you will also notice that I have introduced an employee ID in Column A (just a simple 1,2,3...etc. for the sake of the exercise). I'm not sure how your work book is set out but you can of course create your own employee ID. Just change it in the code.

The code will also delete the Input sheet entries when the data is transferred as I have assumed that you would not want to clutter up the Input sheet with used data.

The following code will also do the same task for you:-

Sub TransferItAlso()
Application.ScreenUpdating = False
Dim lRow As Long
Sheets("Input").Select
lRow = Range("A" & Rows.Count).End(xlUp).Row

For Each Cell In Range("A2:A" & lRow)
    If Cell = 1 Then
    Cell.EntireRow.Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    
    ElseIf Cell = 2 Then
    Cell.EntireRow.Copy Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    
    ElseIf Cell = 3 Then
    Cell.EntireRow.Copy Sheets("Sheet4").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    
    ElseIf Cell = 4 Then
    Cell.EntireRow.Copy Sheets("Sheet5").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    
    ElseIf Cell = 5 Then
    Cell.EntireRow.Copy Sheets("Sheet6").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    
    ElseIf Cell = 6 Then
    Cell.EntireRow.Copy Sheets("Sheet7").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    
    ElseIf Cell = 7 Then
    Cell.EntireRow.Copy Sheets("Sheet8").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    
    ElseIf Cell = 8 Then
    Cell.EntireRow.Copy Sheets("Sheet9").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    
    ElseIf Cell = 9 Then
    Cell.EntireRow.Copy Sheets("Sheet10").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    
    End If
 
Next Cell

Sheets("Input").Range("A2:G" & Rows.Count).ClearContents
MsgBox "Data transfer completed!", vbExclamation
Application.ScreenUpdating = True

End Sub

This code will transfer a whole row of data without actually referring to fixed ranges.

You can have a look at my test workbook at the following link:-

https://www.dropbox.com/s/kbithexwnzspqsk/Stacy610.xlsm?dl=0

so you can see how it works. I have named the tabs with fictitious employee names in the test work book.

I hope this helps.

Kind regards,
vcoolio.

vcoolio · Answer

Hello again Stacy,

I've just picked up on a teeny weeny error in the first code above.

On line 33 (about half way along) you'll see ".Copy Sheet("Sheet10")". Just change Sheet to Sheets. I left out the "s", sorry. If you copy the code from the post, this could give you an annoying error message when you run it if its not changed.

Regards,
vcoolio.

Data Transffering

2 responses

Similar discussions

Subscribe To Our Newsletter!