This works perfectly! I would like it to do just one more thing,
though.
In the second to last line of code, instead of scrolling three lines
after it processes three lines, I would like it to wait until the loop
has run twelve times and then scroll 36 lines, or a screen, to follow
the action. I've added the LoopCounter variable, I believe that I just
need some kind of For ... Next or Do Until around the line
"ActiveWindow.SmallScroll Down:=3".


Public Sub CopyRecordsfromDatatoDatabase()

Dim myArray(7)
Dim numRows As Single
Dim myColumn As Integer, myRow As Single
Dim i As Integer
Dim LoopCounter As Single

myRow = 2
i = 1
LoopCounter = 0

Worksheets("data").Activate
numRows = Selection.CurrentRegion.Rows.Count

Do
For myColumn = 6 To 26

Worksheets("data").Activate
With ActiveSheet
myArray(1) = .Cells(myRow, 5)
myArray(2) = .Cells(myRow, 3)
myArray(3) = .Cells(myRow, 2)
myArray(4) = .Cells(1, myColumn)
myArray(5) = .Cells(myRow, myColumn)
myArray(6) = .Cells(myRow + 1, myColumn)
myArray(7) = .Cells(myRow + 2, myColumn)

.Cells(myRow, myColumn).Clear
.Cells(myRow + 1, myColumn).Clear
.Cells(myRow + 2, myColumn).Clear
End With

Worksheets("Database").Activate
With ActiveSheet
i = i + 1
.Range(.Cells(i, 1), .Cells(i, 7)) = myArray
End With

Next myColumn

Worksheets("data").Activate
With ActiveSheet
.Cells(myRow, 5).Clear
.Cells(myRow, 3).Clear
.Cells(myRow, 2).Clear
End With

myRow = myRow + 3
LoopCounter = LoopCounter + 1

ActiveWindow.SmallScroll Down:=3

Loop Until Cells(myRow, 1).Row numRows

End Sub