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

robgoldstein

Board Regular
Joined
Oct 26, 2013
Messages
165
Office Version
  1. 2019
Platform
  1. Windows
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?
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
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]
 
Upvote 0
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:
Upvote 0


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.


 
Upvote 0
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.
 
Upvote 0
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:
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,223,885
Messages
6,175,187
Members
452,616
Latest member
intern444

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top