Hi

Try this (not tested):

Sub aaa()
Dim TargetRange As Range
Dim ColsSelection
Dim RowsSelection
Dim RowsBetween
Dim Diff
Dim CopyRange As Range
Dim xCell

Set TargetRange = Range("D1:H10")
ColsSelection = TargetRange.Columns.Count
RowsSelection = TargetRange.Rows.Count
RowsBetween = 3
Diff = Selection.Row - 1
For Each xCell In TargetRange.Columns(1)
If xCell.Row Mod RowsBetween = Diff Then
Set CopyRange = xCell.Resize(1, ColsSelection)
CopyRange.Copy
TargetRange.Cells(1, 1).Offset(off, 0).PasteSpecial
Paste:=xlPasteValues
Application.CutCopyMode = False
TargetRange.Cells(1, 1).Offset(off, 0).Resize(1,
ColsSelection).NumberFormat = "0"
End If
Next xCell
'Range("A2").Activate
End Sub

Regards,
Per


On 7 Maj, 01:26, mcwilsong
wrote:
I have some code that goes through a range (for example, D1:H10) and for
every 3rd row, it highlights D3:H3, copies it and then moves up one row to D2
and paste specials the value. I'm trying to alter a piece of code I used to
insert the formula in the same cell range that I am copying and pasting, but
I'm missing how to prevent it from not selecting every 3rd row in the range
as it loops.

Here's the code:
-----Begin Code-----
Dim ColsSelection
Dim RowsSelection
Dim RowsBetween
Dim Diff
Dim FinalRange
Dim xCell

* * Range("D1:H10").Select
* * ColsSelection = Selection.Columns.Count
* * RowsSelection = Selection.Rows.Count
* * RowsBetween = 3
* * Diff = Selection.Row - 1
* * Selection.Resize(RowsSelection, 1).Select
* * Set FinalRange = Selection. _
* * * *Offset(RowsBetween - 1, 0).Resize(1, ColsSelection)
* * For Each xCell In Selection
* * * * If xCell.Row Mod RowsBetween = Diff Then
* * * * * * Set FinalRange = Application.Union _
* * * * * * * * (FinalRange, xCell.Resize(1, ColsSelection))
* * * * * * FinalRange.Select
* * * * * * Selection.Copy
* * * * * * ActiveCell.Offset(-1, 0).Select
* * * * * * Selection.PasteSpecial Paste:=xlPasteValues
* * * * * * Application.CutCopyMode = False
* * * * * * Selection.NumberFormat = "0"
* * * * End If
* * Next xCell
* * Range("A2").Activate

End Sub
-----End Code-----

Specifically, this piece to the code:

Set FinalRange = Application.Union(FinalRange, xCell.Resize(1, ColsSelection))

Tells it to keep adding to the selected range, but I don't want it to keep
adding to the selected range. I want it to move down 4 rows and then select
D6:H6 and copy and paste special value again. I tried commenting out the
Union code, but then it keeps selecting D3:H3 through each loop. Any
suggestions as to how I can get it to stop adding to the selected range?

Thanks for any help.