pull data from sheet and put it into another sheet if that line is checked off

robgoldstein

Board Regular
Joined
Oct 26, 2013
Messages
114
I have a list of people with other information about that person and I want to get selected people and their columns of information into another sheet. Ideally I would like to have a column that I would put an x on the rows I want in the other sheet.
Is there a way to do this?
 

Some videos you may like

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.

robgoldstein

Board Regular
Joined
Oct 26, 2013
Messages
114
I have a list of people with other information about that person and I want to get selected people and their columns of information into another sheet. Ideally I would like to have a column that I would put an x on the rows I want in the other sheet.
Is there a way to do this?

Here is the info I want to pull from list of people on another sheet. I think I could do it with a Vlookup, but don't know how to do it from another sheet & what happens if there are 2 people with the same name?


First NameUniform #registration #CardGoals

<tbody>
</tbody>
 

alansidman

Well-known Member
Joined
Feb 26, 2007
Messages
5,208
Office Version
2019
Platform
Windows
Assume your X is placed in Column A. The items shown in your post are in columns B:F. Your sheets are named "Sheet1" and "Sheet2"
This code will do what you wish.

Code:
Option Explicit


Sub CpyPst()
    Dim s1 As Worksheet, s2 As Worksheet
    Dim i As Long, lr As Long, lr2 As Long
    Set s1 = Sheets("Sheet1"): Set s2 = Sheets("Sheet2")
    lr = s1.Range("B" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    For i = 2 To lr
        lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row
        If s1.Range("A" & i) = "x" Then
            s1.Range("B" & i & ":F" & i).Copy s2.Range("A" & lr2 + 1)
        End If
    Next i
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "completed"
End Sub
Standard Module
How to install your new code
Copy the Excel VBA code
Select the workbook in which you want to store the Excel VBA code
Press Alt+F11 to open the Visual Basic Editor
Choose Insert > Module
Edit > Paste the macro into the module that appeared
Close the VBEditor
Save your workbook (Excel 2007+ select a macro-enabled file format, like *.xlsm)


To run the Excel VBA code:
Press Alt-F8 to open the macro list
Select a macro in the list
Click the Run button
 
Last edited:

robgoldstein

Board Regular
Joined
Oct 26, 2013
Messages
114
[HR][/HR][HR][/HR]Thanks so much. I have never used Macros before. It worked but I need the destination to go to row 18 and down from there. I thought if I just changed the ("A" & lr2 + 1) to ("A" & lr18 + 1) it would work, but it didn't.


 

robgoldstein

Board Regular
Joined
Oct 26, 2013
Messages
114
Alan,
Thank you so much. by filling in the empty cells in column A I have managed to make this work perfectly. I really appreciate your help.
 

robgoldstein

Board Regular
Joined
Oct 26, 2013
Messages
114
Alan,
I loved your solution so much I realized I should make this even better. From the roster we pull 3 different teams. Originally I thought I would just run this 3 times. Is it possible to just indicate 1,2 or 3 and put them into sheets Team 1, Team 2, Team 3?

I tried adapting your code but I get an error at after End if

Option Explicit




Sub CpyPst()
Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet, s4 As Worksheet
Dim i As Long, lr As Long, lr2 As Long
Set s1 = Sheets("Roster"): Set s2 = Sheets("Team 1"): Set s3 = Sheets("Team 2"): Set s4 = Sheets("Team 3")
lr = s1.Range("B" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For i = 2 To lr
lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row
If s1.Range("A" & i) = "1" Then
s1.Range("B" & i & ":F" & i).Copy s2.Range("A" & lr2 + 1)
If s1.Range("A" & i) = "2" Then
s1.Range("B" & i & ":F" & i).Copy s3.Range("A" & lr2 + 1)
If s1.Range("A" & i) = "3" Then
s1.Range("B" & i & ":F" & i).Copy s4.Range("A" & lr2 + 1)
End If
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "completed"
End Sub






I don't know if anything I changed would work or not.

Thanks so much for your help.
 
Last edited:

alansidman

Well-known Member
Joined
Feb 26, 2007
Messages
5,208
Office Version
2019
Platform
Windows
I think that this might do it.

Code:
Sub CpyPst()
    Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet, s4 As Worksheet
    Dim i As Long, lr As Long, lr2 As Long
    Set s1 = Sheets("Roster"): Set s2 = Sheets("Team 1"): Set s3 = Sheets("Team 2"): Set s4 = Sheets("Team 3")
    lr = s1.Range("B" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    For i = 2 To lr
        If s1.Range("A" & i) = "1" Then
            lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row
            s1.Range("B" & i & ":F" & i).Copy s2.Range("A" & lr2 + 1)
            If s1.Range("A" & i) = "2" Then
                lr2 = s3.Range("A" & Rows.Count).End(xlUp).Row
                s1.Range("B" & i & ":F" & i).Copy s3.Range("A" & lr2 + 1)
                If s1.Range("A" & i) = "3" Then
                    lr2 = s4.Range("A" & Rows.Count).End(xlUp).Row
                    s1.Range("B" & i & ":F" & i).Copy s4.Range("A" & lr2 + 1)
                End If
            End If
        End If
    Next i
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "completed"
End Sub
BTW: When posting code, please enclose it in code tags as it makes it easier to read. To do that, highlight your code and then click on the # sign in the menu.
 

robgoldstein

Board Regular
Joined
Oct 26, 2013
Messages
114
Alan,
Thank you so much. Unfortunately that new code only filled in the team 1 sheet. the other 2 remained blank. I did get a "complete" message thought.
 

alansidman

Well-known Member
Joined
Feb 26, 2007
Messages
5,208
Office Version
2019
Platform
Windows
Time to see your actual data file or at least a sanitized representative of your real file. Suggest you upload a sample that is representative to a third party location like dropbox or box.net so that we can evaluate what is not happening and why.
 

Watch MrExcel Video

Forum statistics

Threads
1,090,459
Messages
5,414,647
Members
403,540
Latest member
mmorejon1215

This Week's Hot Topics

Top