simplify code copying from one workbook to another

  • Thread starter Thread starter tcnolan
  • Start date Start date
T

tcnolan

Hi,

I have code that is looping thru data in one worksheet and copying
certain rows to another workbook. It works fine but is very slow. I
think it is how I am selecting the sheets to copy/paste the data. (I
do have screenupdating off, etc.).

If someone could look and let me know how to simplify this code, I
would appreciate it. I know I am not writing it the most efficient way
but can't seem to get the syntax correct. This is the code in between
the For Each cell...Next routine:

*************************************
If cell = strLookup Then
currentbook.Sheets("Sheet1").Activate
Sheets("Sheet1").Range("A" & cell.row, "B" & cell.row).Copy

new_wkbk.Sheets("NewSheet").Activate
Sheets("NewSheet").Range("a" & cellnum).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
End If
*************************************

Thank you,

Terry
 
If cell = strLookup Then
currentbook.Sheets("Sheet1").Range("A" & cell.row, "B" &
cell.row).Copy


new_wkbk.Sheets("NewSheet").Range("a" & cellnum).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If

HTH

Charles Chickering
 
Hi Charles,

Thank you for posting that code. It does work but did not speed up the
copying of the data.

The code is only searching thru 1000 rows and copying a total of 200
rows to a new workbook. But it is taking over 2 minutes.

Maybe I'll try adding the worksheet to the current book, copying the
data there then moving it to a new workbook.

Terry
 
Terry, try using Excel's find function instead of the loop. This might
speed you up.

Sub FindCopy()

' Macro written 8/22/2006 by CChickering

Dim fCell As Range
Dim fAddr As String
Dim strLookup As String
strLookup = "YourSearchVal"
Set fCell =
currentbook.Sheets("Sheet1").Cells.Find(What:=strLookup,
After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
If fCell Is Nothing Then Exit Sub
fAddr = fCell.Address
Do
fCell.EntireRow.Copy
new_wkbk.Sheets("NewSheet").Range("a" & cellnum).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Set fCell =
currentbook.Sheets("Sheet1").Cells.FindNext(After:=ActiveCell)
Loop While fCell.Address <> fAddr
End Sub

Charles
 
Hi Charles,

Thank you. I will try that code also. I changed my code to create the
new sheet in the current workbook and then move that sheet to a new
workbook. It was much, much faster than opening a new workbook and
copying the rows.

Terry
 
Back
Top