Adding rows and copying cells

[cat.aires]

Hi all

I have a very long worksheet that I need to edit, and to avoid a lot of clicking I decided to try some VBA coding. But, being a first time VBA user, this is getting a lot more complicated than I first thought it would. And as much as I think this is an interesting field to explore and learn, I?m running against a deadline here? So, if someone can give me a little help, I would really appreciate it ? and I promise I will come back and learn!

So, what I have is something like this

StationCode.....long1.....long2.....lat1.....lat2.....plong.....plat
Station 1 ..........x1.........x2..........y1......y2
Station 2 ..........x3.........x4..........y3......y4

And what I want to do is:
1. Insert 3 rows under each of the already existing rows
2. Copy the cells in the first 5 columns to the new rows
3. Fill the plong and plat columns with the values in the other long/lat columns, in this way:

StationCode.....long1.....long2.....lat1.....lat2.....plong.....plat
Station 1..........x1..........x2..........y1......y2.......x1.........y1
Station 1..........x1..........x2..........y1......y2.......x1.........y2
Station 1..........x1..........x2..........y1......y2.......x2.........y2
Station 1..........x1..........x2..........y1......y2.......x2.........y1

And then do the same for the rest of the table.


I managed to find a little piece of code that inserts the new rows and change it to the number of rows I want, but now I?m stuck there. Help anyone?

Here is the code I already have
[vba]Sub AddRowsBetween()
Dim lLoop As Long

For lLoop = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
Cells(lLoop, 1).Range("A2:A4").EntireRow.Insert
Next lLoop

End Sub[/vba]

[Bob Phillips]

[vba]

Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 2 Step -1

.Rows(i + 1).Resize(3).Insert
.Cells(i, "A").Resize(, 5).Copy .Cells(i + 1, "A").Resize(3)
.Cells(i, "F").Value = .Cells(i, "B").Value
.Cells(i, "G").Value = .Cells(i, "D").Value
.Cells(i + 1, "F").Value = .Cells(i, "B").Value
.Cells(i + 1, "G").Value = .Cells(i, "E").Value
.Cells(i + 2, "F").Value = .Cells(i, "C").Value
.Cells(i + 2, "G").Value = .Cells(i, "E").Value
.Cells(i + 3, "F").Value = .Cells(i, "C").Value
.Cells(i + 3, "G").Value = .Cells(i, "D").Value
Next i
End With

End Sub
[/vba]

[MaximS]

try this:

[VBA]
Sub AddRowsBetween()
LastRow = (Range("A" & Rows.Count).End(xlUp).Row - 1) * 4
For i = 2 To LastRow
Range(Cells(i, 1), Cells(i + 2, 1)).EntireRow.Insert

For j = 0 To 2
Range(Cells(i + j, 1), Cells(i + j, 5)).Value = _
Range(Cells(i + 3, 1), Cells(i + 3, 5)).Value
Next j

For j = 0 To 3
Select Case j
Case 0
Cells(i + j, 6).Value = Cells(i + j, 2).Value
Cells(i + j, 7).Value = Cells(i + j, 4).Value
Case 1
Cells(i + j, 6).Value = Cells(i + j, 2).Value
Cells(i + j, 7).Value = Cells(i + j, 5).Value
Case 2
Cells(i + j, 6).Value = Cells(i + j, 3).Value
Cells(i + j, 7).Value = Cells(i + j, 4).Value
Case 3
Cells(i + j, 6).Value = Cells(i + j, 3).Value
Cells(i + j, 7).Value = Cells(i + j, 5).Value
End Select
Next j

i = i + 3

Next
End Sub
[/VBA]

[cat.aires]

It worked perfectly, thank you both very much!