VBA block cell copying.

[alan.tyrell]

Need help please,

Need some VBA code i can run.

I need to sort in numerical order and cut (as there are survey photo's
in the sheet) the surrounding cell contents and paste them in to the
bottom of the sheet. Note the sheet will have up to 100 sections to
copy.

There is an old sequential numbering, nominally (a few numbers may be
omitted) 1 though to 100 and new numbering that could be any unique
number between for example 3 to 340

I'll use the example below to show what I'm trying to do....
I wish to re-order the grid (3x3) of cells around the number in the
middle.
I have put in a line space between the 3x3 grid to make reading it as
a text file easier.

Before
--------

1, pp, ppp
X, 3, XXX
n, nn, nnn

2, qq, qqq
X, 1, XXX
m, mm, mmm

3 tt, ttt
X, 2, XXX
d, dd, ddd

4, hh, hhh
X, 6, XXX
l, ll, lll

5, w, www
X, 7, XXX
a, aa, aaa

After
--------

2, qq, qqq
X, 1, XXX
m, mm, mmm

3 tt, ttt
X, 2, XXX
d, dd, ddd

1, pp, ppp
X, 3, XXX
n, nn, nnn

4, hh, hhh
X, 6, XXX
l, ll, lll

5, w, www
X, 7, XXX
a, aa, aaa

 

[obsolent]

How about this? You might look at my assumptions about 'FirstTopRow' and
'LastTopRow'

Public Sub Sort3x3TablesOnMiddleSquare()
FirstTopRow = 2
' The row of the first square,assuming your tables start after a
heading line
LastTopRow = Cells(1).CurrentRegion.Rows.Count - 2
' This should the row of the bottom square

For Outer = FirstTopRow To LastTopRow - 3 Step 3
For Inner = Outer + 3 To LastTopRow Step 3

If Cells(Outer + 1, 2).Value > Cells(Inner + 1, 2).Value Then
Dim SavedCells() As Variant
SavedCells = SaveSquare(Cells(Outer, 1))
Call LoadSquare(Cells(Outer, 1), SaveSquare(Cells(Inner,
1)))
Call LoadSquare(Cells(Inner, 1), SavedCells)
End If

Next Inner
Next Outer

End Sub

Public Function SaveSquare(InCell As Range) As Variant
' Save contents from 9 cell square given top left cell
Dim Out(2, 2) As Variant
For R = 0 To 2
For C = 0 To 2
Out(R, C) = InCell.Offset(R, C).Formula
Next C
Next R
SaveSquare = Out
End Function

Public Sub LoadSquare(InCell As Range, SavedSquare As Variant)
' Load 9 cell square from saved details
For R = 0 To 2
For C = 0 To 2
InCell.Offset(R, C).Formula = SavedSquare(R, C)
Next C
Next R
End Sub