MACRO FOR INSERTING ROWS AND PASTING VALUES
Posted by EDDIE G on October 23, 2001 10:58 AM
I currently have a variation of what I need but I cannot figure out how to change it for my current need. I need a macro that will insert rows starting at row three to end of worksheet, then cut and paste E2:G2 into B3, and so forth and so on through the whole worksheet. Below is the code I use for a similar two-column sheet. I am certain a simple change to the below code will work. Can someone help please?
Sub WEIGHT_PLACER()
Dim rng As Range, nextBlank As Range
Set rng = Range(Range("A2"), Range("A65536").End(xlUp))
Columns("C").Insert
Range("C2").Value = 1
rng.Offset(0, 2).DataSeries
Columns(2).Insert
Range("B2").Value = 1
rng.Offset(0, 1).DataSeries
Set nextBlank = Range("A65536").End(xlUp).Offset(1, 1).Resize(1, 2)
Range(rng.Offset(0, 3), rng.Offset(0, 4)).Copy nextBlank
Columns("A:C").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlYes
Range("B:B,D:E").Delete
End Sub
Posted by Omar Sivori on October 24, 2001 2:44 AM
Sub WEIGHT_PLACER()
Dim rng As Range, nextBlank As Range
Columns("E").Insert
Set rng = Range(Range("F2"), Range("F65536").End(xlUp)).Offset(0, -1)
With rng
.Cells(1, 1).Value = 1
.DataSeries
End With
Set nextBlank = Range("E65536").End(xlUp).Offset(1, 0)
rng.Copy nextBlank
Set rng = Range(Range("E2"), Range("E65536").End(xlUp)).EntireRow
rng.Sort Key1:=Range("E2"), Order1:=xlAscending, Header:=xlNo
Columns("E").Delete
Range(Range("E2"), Range("E65536").End(xlUp)).Resize(, 3).Cut Range("B3")
End Sub
Posted by DOESN'T QUITE WORK on October 24, 2001 5:39 AM
The code you provided deletes the data in rows 2, 4 ,6 and so on. Can you fix it?
Posted by Omar Sivori on October 24, 2001 6:16 AM
Oh ......
I presume you mean that you have data in columns B:D before running the macro. In that case try the following. If it still doesn't work, you will need to describe your worksheet in more detail.
Sub WEIGHT_PLACER()
Dim rng As Range, nextBlank As Range
Columns("E").Insert
Set rng = Range(Range("F2"), Range("F65536").End(xlUp)).Offset(0, -1)
With rng
.Cells(1, 1).Value = 1
.DataSeries
End With
Set nextBlank = Range("E65536").End(xlUp).Offset(1, 0)
rng.Copy nextBlank
Set rng = Range(Range("E2"), Range("E65536").End(xlUp)).EntireRow
rng.Sort Key1:=Range("E2"), Order1:=xlAscending, Header:=xlNo
Columns("E").Delete
With Columns("B:D")
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C[3]"
.Copy
.PasteSpecial Paste:=xlValues
End With
Range(Range("E2"), Range("E65536").End(xlUp)).Resize(, 3).ClearContents
End Sub
Posted by EDDIE G on October 24, 2001 7:46 AM
Re: Oh ......
WORKS GREAT, THANKS A BUNCH.
