DBaker7777
Board Regular
- Joined
- Feb 3, 2009
- Messages
- 53
- Office Version
- 365
- 2016
I have the below code and it works fine, but right now it is not copying all the "New" rows at once and pasting them. It copies one row, opens the workbook, saves, closes the workbook then if it finds another row labeled "New" it repeats the process. This would take a long time if 100's of rows have "New" in them. Is there anyway to grab them all at once and paste them over? Thank you
VBA Code:
Sub myData()
Dim LastRow As Integer, i As Integer, erow As Integer
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Cells(i, 1).Value = "NEW" Then
Range(Cells(i, 2), Cells(i, 13)).Select
Selection.Copy
Workbooks.Open Filename:="C:\History\Archive.xlsm"
Worksheets("Sheet1").Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False
End If
Next i
End Sub