Creating a loop for a copy and paste function

[matri00]

I am very new to using macros (1st day today). I've managed to create a macro that produces the copy and paste function I want. I can't however manage to apply it to the whole spreadsheet, only the first row, I'm guessing I need some sort of loop. The cells in column A are merged to a varying degree, e.g some merged cells contain 4 rows, others may contain,3, or 5. I only want this macro applied to each merged cell from column A and the associated function I've already produced, not every row in the spreadsheet.

Here's what I've got so far:

Sub Macro4()
'
' Macro4 Macro
' Macro recorded 25/05/2011 by Rich
'


Dim mycell As Range
Set mycell = ActiveCell



mycell.Copy
mycell.Offset(0, 9).Select
ActiveSheet.Paste
mycell.Offset(0, 1).Select
Selection.Copy
mycell.Offset(0, 10).Select
ActiveSheet.Paste
mycell.Offset(0, 4).Select
Selection.Copy
mycell.Offset(0, 11).Select
ActiveSheet.Paste
mycell.Offset(0, 2).Select
Selection.Copy
mycell.Offset(0, 12).Select
ActiveSheet.Paste
mycell.Offset(0, 3).Select
Selection.Copy
mycell.Offset(0, 13).Select
ActiveSheet.Paste
mycell.Offset(0, 1).Offset(1, 0).Select
Selection.Copy
mycell.Offset(0, 14).Select
ActiveSheet.Paste
mycell.Offset(0, 4).Offset(1, 0).Select
Selection.Copy
mycell.Offset(0, 15).Select
ActiveSheet.Paste


mycell.Offset(0, 9).Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

End Sub



Any help would be greatly appreciated, Cheers Rich