Faster macro for copy to workbooks

[ste33uka]

Hi would anyone have a faster macro than the following ,to copy data to sheet in current workbook and data to other workbook.
Current macro screen flickers alot when its ran.
Thanks

Sub copy_to_workbooks()
   Dim i As Long
   For i = 1 To 81
      With Sheets(CStr(i))
         If LCase(.Range("vZ2").Value) = "yes" Then
         .Range("vW86:xa106").Copy
            Sheets("COPY").Range("e" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlFormats
            Sheets("COPY").Range("e" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
            Workbooks("book2").Sheets("data").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlFormats
            Workbooks("book2").Sheets("data").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
           .Range("A1:BM76").Copy
           Workbooks("book2").Sheets("collect").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
         End If
      End With
   Next i
End Sub

 

[offthelip]

Copying formats is always going to be slow, So I have a few questions :
1:Why are you looping this code 81 times you don't use the index variable i at all. so you are copying the same thing 81 times.
2: you are copying the same format 162 times , what sort of formating is it? is it the same across all columns or all rows. if it is is is much quicker to apply the format to the entire finished range
What is quite common is to have some columns which are dates or number or currency, if is it the whole column, it is best to use vba to do the formatting rather than copying it.
Accessing the worksheet for anything in a loop is always going to be slow. the way I would do this is copy the VW86:XA106 to a variant array. copy it multiple times to another much larger variant array and then write the large array back to the worksheet. That does the values, then I would format the worksheet as required using VBA

 

[ste33uka]

Copying formats is always going to be slow, So I have a few questions :
1:Why are you looping this code 81 times you don't use the index variable i at all. so you are copying the same thing 81 times.
2: you are copying the same format 162 times , what sort of formating is it? is it the same across all columns or all rows. if it is is is much quicker to apply the format to the entire finished range
What is quite common is to have some columns which are dates or number or currency, if is it the whole column, it is best to use vba to do the formatting rather than copying it.
Accessing the worksheet for anything in a loop is always going to be slow. the way I would do this is copy the VW86:XA106 to a variant array. copy it multiple times to another much larger variant array and then write the large array back to the worksheet. That does the values, then I would format the worksheet as required using VBA

There is 81 sheets on the workbook, each sheet has different data,
the formatting i am copying is borders and conditional formatting
Would prefer to copy the format at same time rather than after.
Thanks for your help

 

[offthelip]

I hadn't spotted that, so my comments are wrong. To stop the screen flickering you can turn offf screen updating, it is also probably worth trying turning off the auto recalculation while your doing the copying and only do a recalculation at the end, this might speed it up a bit; so put this at the top:

Application.screenupdating=false
Application.Calculation = xlCalculateManual

then at the end of the sub turn them back on again with:

Application.screenupdating=True
Application.Calculation = xlCalculationAutomatic

 

[ste33uka]

Like this ?

 Sub copy_to_workbooks()
Application.screenupdating=false
Application.Calculation = xlCalculateManual

Dim i As Long
For i = 1 To 81
With Sheets(CStr(i))
If LCase(.Range("vZ2").Value) = "yes" Then
.Range("vW86:xa106").Copy
Sheets("COPY").Range("e" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlFormats
Sheets("COPY").Range("e" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
Workbooks("book2").Sheets("data").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlFormats
Workbooks("book2").Sheets("data").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
.Range("A1:BM76").Copy
Workbooks("book2").Sheets("collect").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End If
End With
Next i
Application.screenupdating=True
Application.Calculation = xlCalculationAutomatic

End Sub

 

[offthelip]

Yes that should stop the the screen flickering and might speed it up very slightly. The only other way I can think of speeding it up, is to copy the ranges VW86:XA106 and A1:BM76 to variant arrays in a loop and build up 2 large variant arrays, and then write these two variant arrays back to data and collect sheet in one action at the end of the loop, this should save 3 worksheet accesses per loop. This would require keeping track of what rows be needed to formatted separately because the data wouldn't be there initially. so a bit complicated.

 

[ste33uka]

Yes that should stop the the screen flickering and might speed it up very slightly. The only other way I can think of speeding it up, is to copy the ranges VW86:XA106 and A1:BM76 to variant arrays in a loop and build up 2 large variant arrays, and then write these two variant arrays back to data and collect sheet in one action at the end of the loop, this should save 3 worksheet accesses per loop. This would require keeping track of what rows be needed to formatted separately because the data wouldn't be there initially. so a bit complicated.

Thanks alot for your help.