Copy one cell to next cell in new sheet based on another cell

[kingdomb]

I need a Macro to copy/paste data from one cell into the next cell in new sheet based on a different cell in the origional sheet.
Sheet 1, Column A has a list of names. If Sheet1, B2 has value="5" then I want to copy sheet1,A2 and paste it into sheet2, Column A next available cell. Note there may be many rows where column B is =5 so I want to be able to run a macro that will do all of them at once. I hope to have a list of "A" values on sheet2 where "B" was equal to 5.
Sorry if this doesn't make sense.

 

[asking]

Try this macro ~ Save your workbook before proceeding

Row 1 Needs to be either blank or a header row.

Sub Move5()
Application.ScreenUpdating = False
    Sheets("Sheet1").Select
If Range("A1") = "" Then
    Range("A1").Select
        ActiveCell.FormulaR1C1 = "1"
            End If
If Range("B1") = "" Then
    Range("B1").Select
        ActiveCell.FormulaR1C1 = "2"
             End If
ActiveSheet.Range("$A$1:$B$1").AutoFilter Field:=2, Criteria1:="5"
    Range("=OFFSET($A$2,0,0,COUNTA(OFFSET($A$2,0,0,9999)),1)").Select
        Selection.SpecialCells(xlCellTypeVisible).Select
            Selection.Copy
                Sheets("Sheet2").Select
    Range("A2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            Sheets("Sheet1").Select
                Application.CutCopyMode = False
                     Selection.AutoFilter
    Application.ScreenUpdating = True
End Sub

 

[kingdomb]

Holy Crikey! That works perfectly.Thanks mate!

 

[kingdomb]

I had partial success with this code using 2007 (at home) but not with 2003 (at work). I adjusted the code a bit to give me the correct column but there is still an issue. If there are spaces in column B it causes a problem. It counts the number of values in column B (say 10 values) and then gives me the first 10 names from column A. I need it to correlate the name with the value despite spaces in Column B. I also wanted to try to pull the value of column B. Here is the Macro as I adjusted it.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>

Sub Move5()
Application.ScreenUpdating = False
Sheets("Sheet1").Select
If Range("A1") = "" Then
Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
End If
If Range("B1") = "" Then
Range("B1").Select
ActiveCell.FormulaR1C1 = "2"
End If
ActiveSheet.Range("$A$1:$B$1").AutoFilter Field:=2, Criteria1:="<>"
Range("=OFFSET($b$2,0,-1,COUNTA(OFFSET($b$2,0,0,9999)),1)").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Sheet2").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1").Select
Application.CutCopyMode = False
Selection.AutoFilter
Application.ScreenUpdating = True
ActiveSheet.Range("$A$1:$B$1").AutoFilter Field:=2, Criteria1:="<>"
Range("=OFFSET($b$2,0,0,COUNTA(OFFSET($b$2,0,0,9999)),1)").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Sheet2").Select
Range("b2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1").Select
Application.CutCopyMode = False
Selection.AutoFilter
Application.ScreenUpdating = True
End Sub

 

[kingdomb]

To be clear I had intended to take this formula and repeat it 14 times with modifications to make a scheduling program. I want to place names in column A and the shifts worked in columns B-0. Then I need to just pull the name and shift from each day to a separate daily list. Thanks.

 

[asking]

Hi kingdomb,

The macro would need a re-write, but probably better done with a pivot table.

If you wish to do it with a macro it would be best to post ~ if your sheet has a header row, what's in each column and where you want the data to go. Also the criteria for for each transfer. Is the data in a named table or just loose?

The original macro I sent was very basic and only for two columns as I had no knowledge whether you had a header row in row 1 with names for each column or not.

Some formulas that work in 2007 will not work in 2003 and as I do not have 2003 I can't test for both.

Cheers

 

[kingdomb]

The main sheet is called "2 week schedule". The Header row would be "staff" (in A1) and "1st" (B1), "2nd" (C1) etc through to the "14th" (O1). I want to create 14 additional sheets titled "1st" through the "14th" with headers in a1 "staff" and b1 "shift" in each of the 14 sheets. If the staff member was working 0700-1900 on the 1st day of the schedule I want to capture that person's name and the time they are working and copy it over to the next available line in sheet "1st Day", name in column a, shift in column b. . If then another person 4 rows down is also working that day 0700-1900 I want to capture their name and shift and place it in the next available space in sheet "1st". The criteria would be <> any data inputted in B-O below the header row would trigger the transfer when the macro was fired. I had planned to keep it loose.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
The Macro you sent worked in 2007 for the transferring the names, even if it was several rows apart. It started giving me problems when I tried to bastardize it and have it pull the second piece of data. I have no idea how to write any of this but I fiddle with things and often get it to work for me. Thanks so much for your help, if you can get something working or not.

 

[asking]

Hi kingdomb,

I think I have what you want. I have done the code for the first 3 transfers to sheet 1st, 2nd and 3rd. Run the macro below, if it is does what you require for those 3 sheets, have a go at filling in the rest for the remaining sheets. If you get stuck I will help.

The first thing to do is on the sheet "2 week schedule" is select A1:O99, click on formula menu, click create from selection, click top row only, click OK. That will give the names that will take you to the right sheets. Then this code (macro) ~

Sub Schedule()
Application.ScreenUpdating = False
Sheets("2 week schedule").Select

'First transfer to sheet 1st
Range("A1:O1").Select
    ActiveWorkbook.Names.Add Name:="Sched", RefersToR1C1:= _
        "='2 week schedule'!R1C1:R1C15"
Range("Sched").AutoFilter Field:=2, Criteria1:="<>"
Range("=OFFSET($A$2,0,0,COUNTA(OFFSET($A$2,0,0,9999)),2)").Select
        Selection.SpecialCells(xlCellTypeVisible).Select
            Selection.Copy
            Sheets("1st").Select
Range("A2").Select
ActiveSheet.Paste

'Second transfer to sheet 2nd
Sheets("2 week schedule").Select
Range("Sched").AutoFilter Field:=2
Range("Sched").AutoFilter Field:=3, Criteria1:="<>"
Range("=OFFSET($A$2,0,0,COUNTA(OFFSET($A$2,0,0,9999)),1)").Select
        Selection.SpecialCells(xlCellTypeVisible).Select
            Selection.Copy
            Sheets("2nd").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("2 week schedule").Select
Range("=OFFSET($A$2,0,2,COUNTA(OFFSET($A$2,0,0,9999)),1)").Select
        Selection.SpecialCells(xlCellTypeVisible).Select
            Selection.Copy
            Sheets("2nd").Select
Range("B2").Select
ActiveSheet.Paste

'Third transfer to sheet 3rd
Sheets("2 week schedule").Select
Range("Sched").AutoFilter Field:=3
Range("Sched").AutoFilter Field:=4, Criteria1:="<>"
Range("=OFFSET($A$2,0,0,COUNTA(OFFSET($A$2,0,0,9999)),1)").Select
        Selection.SpecialCells(xlCellTypeVisible).Select
            Selection.Copy
            Sheets("3rd").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("2 week schedule").Select
Range("=OFFSET($A$2,0,3,COUNTA(OFFSET($A$2,0,0,9999)),1)").Select
        Selection.SpecialCells(xlCellTypeVisible).Select
            Selection.Copy
            Sheets("3rd").Select
Range("B2").Select
ActiveSheet.Paste

'Insert code here for remaining sheets

Sheets("2 week schedule").Select
    Application.CutCopyMode = False
        Selection.AutoFilter
Application.ScreenUpdating = True
End Sub

Cheers

 

[kingdomb]

This is working great! Thank you so much. I haven't tried it on 2003 yet but it is flawless on 2007. There is one other function I have been stumped on. How do I set 3 criteria instead of "<>". These would be "A", "B", and "9". I tried xlor] but it only lets me have 2 criteria?? Here is the first 2 parts of your code as I've been using it.



Sub DailySheetGenerator()
Application.ScreenUpdating = False
Sheets("4 week schedule").Select
'First transfer to sheet 1st
Range("A1:AC1").Select
ActiveWorkbook.Names.Add Name:="Sched", RefersToR1C1:= _
"='4 week schedule'!R1C1:R1C29"
Range("Sched").AutoFilter Field:=2, Criteria1:="<>"
Range("=OFFSET($A$2,0,0,COUNTA(OFFSET($A$2,0,0,9999)),2)").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("1st").Select
Range("A2").Select
ActiveSheet.Paste
'Second transfer to sheet 2nd
Sheets("4 week schedule").Select
Range("Sched").AutoFilter Field:=2
Range("Sched").AutoFilter Field:=3, Criteria1:="<>"
Range("=OFFSET($A$2,0,0,COUNTA(OFFSET($A$2,0,0,9999)),1)").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("2nd").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("4 week schedule").Select
Range("=OFFSET($A$2,0,2,COUNTA(OFFSET($A$2,0,0,9999)),1)").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("2nd").Select
Range("B2").Select
ActiveSheet.Paste

 

[asking]

Hi,
Glad it worked for you!

To set 3 criteria' for your fields , you would do it as an array, for A, B and 9 ~


Range("Sched").AutoFilter Field:=3, Criteria1:=Array("9", _
"A", "B"), Operator:=xlFilterValues

You can do as many as you like in the array, If you had C as well as A,B and 9 ~

Range("Sched").AutoFilter Field:=3, Criteria1:=Array("9", _
"A", "B", "C"), Operator:=xlFilterValues

Cheers.