I have a source sheet which has the data set in consecutive rows in each of
four sheets. The data has to be copied and pasted in selected workbooks but
in every other row. My current procedure works well but is very slow. Is
there a more efficient way to accomplish this? The below represents this
portion of the operation.

Do

Workbooks(wbk1).Activate
Activecell.Offset(1,0).activate
Activecell.Copy
Workbooks(wbk2).Activate
Activecell.Offset(2,).Activate
Activecell.PasteSpecial

Loop until (certain conditions are encountered)
--
Thanks,

Jim

Jim,

try the code below, it worked for me in milliseconds for over 10,000
rows:


Sub PasteEveryOtherRow()
Dim wbk1, wbk2 As Workbook, _
i, j, lRow As Long

Set wbk1 = ActiveWorkbook
Set wbk2 = Workbooks.Add

i = 1
j = 2
lRow = wbk1.Sheets(1).Range("A65536").End(xlUp).Row

Do Until i = lRow

wbk2.Sheets(1).Cells(j, 1).Value = wbk1.Sheets(1).Cells(i,
1).Value
i = i + 1
j = j + 2

Loop

End Sub

Dave, I think you have solved it for me. A little editing to fit my
particular specs and I believe it will be just what I needed.

Thanks,

Jim


"Dave Miller" wrote:

Jim,

try the code below, it worked for me in milliseconds for over 10,000
rows:


Sub PasteEveryOtherRow()
Dim wbk1, wbk2 As Workbook, _
i, j, lRow As Long

Set wbk1 = ActiveWorkbook
Set wbk2 = Workbooks.Add

i = 1
j = 2
lRow = wbk1.Sheets(1).Range("A65536").End(xlUp).Row

Do Until i = lRow

wbk2.Sheets(1).Cells(j, 1).Value = wbk1.Sheets(1).Cells(i,
1).Value
i = i + 1
j = j + 2

Loop

End Sub