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

You can just add a simple If...Then Statement at the end. I would also
recommend you change your variable declarations to Double and Longs. Not a
big deal, but I think VB runs a micro second faster this way, because it has
to convert Singles and Integers, but I could be wrong. Heres your code.
Hope this helps! If so, let me know, click "YES" below.

Public Sub CopyRecordsfromDatatoDatabase()

Dim myArray(7)
Dim numRows As Double
Dim myColumn As Long
Dim myRow As Double
Dim i As Long
Dim LoopCounter As Long

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

If Int(LoopCounter / 12) = LoopCounter / 12 Then
ActiveWindow.SmallScroll Down:=36
End If

Loop Until Cells(myRow, 1).Row numRows

End Sub
--
Cheers,
Ryan


"Slim Slender" wrote:

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
.