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

[robgoldstein]

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?

 

[robgoldstein]

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?


[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]First Name[/TD]
[TD]Uniform #[/TD]
[TD]registration #[/TD]
[TD]Card[/TD]
[TD]Goals[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[alansidman]

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.

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

 

[robgoldstein]

---

---

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]

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]

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.

 

[alansidman]

I think that this might do it.

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]

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]

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.

 

[robgoldstein]

Wow, thanks so much
Here is a dropbox link to the file. I have some extra columns on the roster sheet because I am going to use them for a mail merge to notify parents of their kid's game times and location. Those don't need to be pulled.
https://www.dropbox.com/s/t630m7oufn8ax2m/GTISL Game Sheet test.xlsm?dl=0