Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Values to Below last Populated Cell Q
I am trying to copy values in Trade up Meals cells A9; B9; J18; K18; L18;
N18; O18 (and for every 12th Row below these values) to a sheet called Ingredient Products starting on the row below the last populated cell. I am using the following code but am getting very unreliable data, does the code look ok? Thanks Sub TradeupCostToIngredients_Post() Dim I As Long, j As Long, k As Long, l As Long Dim rng As Range, cell As Range With Worksheets("Trade Up Meals") Set rng = Union(.Range("A9"), .Range("B9"), .Range("J18"), .Range("K18"), ..Range("L18"), .Range("N18"), .Range("O18")) I = 0 j = 0 l = 0 For Each cell In rng j = cell.Row l = l + 1 k = Worksheets("Ingredient Products").Cells(Rows.Count, l).End(xlUp).Row + 1 Do While Not IsEmpty(.Cells(j, cell.Column)) .Cells(j, cell.Column).Copy Worksheets("Ingredient Products") _ .Cells(k, l).PasteSpecial xlValues k = k + 1 j = j + 12 Loop Next End With Sheets("Ingredient Products").Select Columns("B:B").Select Columns("B:B").EntireColumn.AutoFit Columns("C:G").Select Application.CutCopyMode = False Selection.NumberFormat = "#,##0.00" Range("A1").Select Set rng = Range("A1:G1").Resize(Cells(Rows.Count, "A").End(xlUp).Row, 7) Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom Range("A1").Select Sheets("Master").Select Range("A1").Select End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Values to Below last Populated Cell Q
John,
Try the code below to see if it improves your results. HTH, Bernie MS Excel MVP Sub TradeupCostToIngredients_Post2() Dim i As Long Dim myStartRow As Long Dim Rng1 As Range Dim Rng2 As Range Dim mySht As Worksheet Set mySht = Worksheets("Ingredient Products") myStartRow = mySht.Cells(mySht.Rows.Count, 1).End(xlUp)(2).Row With Worksheets("Trade Up Meals") Set Rng1 = Union(.Range("A9"), .Range("B9")) Set Rng2 = Union(.Range("J18"), .Range("K18"), _ .Range("L18"), .Range("N18"), .Range("O18")) For i = 0 To .Range("A65536").End(xlUp).Row Step 12 Set Rng1 = Union(Rng1, Rng1.Offset(i, 0)) Next i Rng1.Copy mySht.Cells(myStartRow, 1) For i = 0 To .Range("A65536").End(xlUp).Row Step 12 Set Rng2 = Union(Rng2, Rng2.Offset(i, 0)) Next i Rng2.Copy mySht.Cells(myStartRow, 3) End With With Sheets("Ingredient Products") .Columns("B:B").AutoFit .Columns("C:G").NumberFormat = "#,##0.00" .Range("A1").CurrentRegion.Sort Key1:=.Range("A1"), _ Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom .Range("A1").Select End With End Sub "John" wrote in message ... I am trying to copy values in Trade up Meals cells A9; B9; J18; K18; L18; N18; O18 (and for every 12th Row below these values) to a sheet called Ingredient Products starting on the row below the last populated cell. I am using the following code but am getting very unreliable data, does the code look ok? Thanks Sub TradeupCostToIngredients_Post() Dim I As Long, j As Long, k As Long, l As Long Dim rng As Range, cell As Range With Worksheets("Trade Up Meals") Set rng = Union(.Range("A9"), .Range("B9"), .Range("J18"), .Range("K18"), .Range("L18"), .Range("N18"), .Range("O18")) I = 0 j = 0 l = 0 For Each cell In rng j = cell.Row l = l + 1 k = Worksheets("Ingredient Products").Cells(Rows.Count, l).End(xlUp).Row + 1 Do While Not IsEmpty(.Cells(j, cell.Column)) .Cells(j, cell.Column).Copy Worksheets("Ingredient Products") _ .Cells(k, l).PasteSpecial xlValues k = k + 1 j = j + 12 Loop Next End With Sheets("Ingredient Products").Select Columns("B:B").Select Columns("B:B").EntireColumn.AutoFit Columns("C:G").Select Application.CutCopyMode = False Selection.NumberFormat = "#,##0.00" Range("A1").Select Set rng = Range("A1:G1").Resize(Cells(Rows.Count, "A").End(xlUp).Row, 7) Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom Range("A1").Select Sheets("Master").Select Range("A1").Select End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Values to Below last Populated Cell Q
Thanks Bernie
"Bernie Deitrick" <deitbe @ consumer dot org wrote in message ... John, Try the code below to see if it improves your results. HTH, Bernie MS Excel MVP Sub TradeupCostToIngredients_Post2() Dim i As Long Dim myStartRow As Long Dim Rng1 As Range Dim Rng2 As Range Dim mySht As Worksheet Set mySht = Worksheets("Ingredient Products") myStartRow = mySht.Cells(mySht.Rows.Count, 1).End(xlUp)(2).Row With Worksheets("Trade Up Meals") Set Rng1 = Union(.Range("A9"), .Range("B9")) Set Rng2 = Union(.Range("J18"), .Range("K18"), _ .Range("L18"), .Range("N18"), .Range("O18")) For i = 0 To .Range("A65536").End(xlUp).Row Step 12 Set Rng1 = Union(Rng1, Rng1.Offset(i, 0)) Next i Rng1.Copy mySht.Cells(myStartRow, 1) For i = 0 To .Range("A65536").End(xlUp).Row Step 12 Set Rng2 = Union(Rng2, Rng2.Offset(i, 0)) Next i Rng2.Copy mySht.Cells(myStartRow, 3) End With With Sheets("Ingredient Products") .Columns("B:B").AutoFit .Columns("C:G").NumberFormat = "#,##0.00" .Range("A1").CurrentRegion.Sort Key1:=.Range("A1"), _ Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom .Range("A1").Select End With End Sub "John" wrote in message ... I am trying to copy values in Trade up Meals cells A9; B9; J18; K18; L18; N18; O18 (and for every 12th Row below these values) to a sheet called Ingredient Products starting on the row below the last populated cell. I am using the following code but am getting very unreliable data, does the code look ok? Thanks Sub TradeupCostToIngredients_Post() Dim I As Long, j As Long, k As Long, l As Long Dim rng As Range, cell As Range With Worksheets("Trade Up Meals") Set rng = Union(.Range("A9"), .Range("B9"), .Range("J18"), ..Range("K18"), .Range("L18"), .Range("N18"), .Range("O18")) I = 0 j = 0 l = 0 For Each cell In rng j = cell.Row l = l + 1 k = Worksheets("Ingredient Products").Cells(Rows.Count, l).End(xlUp).Row + 1 Do While Not IsEmpty(.Cells(j, cell.Column)) .Cells(j, cell.Column).Copy Worksheets("Ingredient Products") _ .Cells(k, l).PasteSpecial xlValues k = k + 1 j = j + 12 Loop Next End With Sheets("Ingredient Products").Select Columns("B:B").Select Columns("B:B").EntireColumn.AutoFit Columns("C:G").Select Application.CutCopyMode = False Selection.NumberFormat = "#,##0.00" Range("A1").Select Set rng = Range("A1:G1").Resize(Cells(Rows.Count, "A").End(xlUp).Row, 7) Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom Range("A1").Select Sheets("Master").Select Range("A1").Select End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
copy to new cells if populated | Excel Discussion (Misc queries) | |||
Copy values from a cell based on values of another cell | Excel Discussion (Misc queries) | |||
copy last populated cell (moving) to another cell | Excel Discussion (Misc queries) | |||
First populated cell in row array/ Last populated cell in row arra | Excel Worksheet Functions | |||
using IF function to copy, but leave populated cell alone | Excel Worksheet Functions |