Visible Cells

[Edgar]

Hi

I have some code which splits a report by a value in a
column using the autofilter.

The code then uses the visible cells property to copy all
records with the same values in that column to another
sheet.

This code takes ages to run.....do you think this is to do
with the visible cells property?

Code below:

TIA

Sub CopyInvoices()
Dim sCriteria As String
Dim sOriginal As String
Dim sNew As String
Dim i As Long
Dim File_Name As String


With ActiveWorkbook

Application.ScreenUpdating = False
Worksheets("Crystal_Table").Activate

With .ActiveSheet
.Rows(1).Insert
.Range("T1").Value = "Test"
sOriginal = .Name
End With

For i = 3 To .ActiveSheet.Cells
(Rows.Count, "H").End(xlUp).Row
sCriteria = .ActiveSheet.Cells(i, "H").Value
If sCriteria <> "" Then
If sCriteria <> .ActiveSheet.Cells(i -
1, "H").Value Then
.Worksheets.Add After:=.Worksheets
(.Worksheets.Count)
.ActiveSheet.Name = sCriteria
sNew = .ActiveSheet.Name
.Worksheets(sOriginal).Activate
With .ActiveSheet
.Columns("H:H").AutoFilter
Field:=1, Criteria1:=sCriteria
.Cells.SpecialCells
(xlCellTypeVisible).Copy
End With
With .Worksheets(sNew)
.Paste
.Rows(1).EntireRow.Delete
.Columns
("W:AQ").EntireColumn.Delete
.Columns
("T:T").EntireColumn.Delete
.Columns
("O:R").EntireColumn.Delete
.Columns
("M:M").EntireColumn.Delete
.Columns
("K:K").EntireColumn.Delete
.Columns
("I:I").EntireColumn.Delete
.Columns
("G:G").EntireColumn.Delete
.Columns
("A:E").EntireColumn.Delete
.Columns("A:H").AutoFit

End With
End If
End If
Next i

.Worksheets(sOriginal).Rows(1).EntireRow.Delete

End With

Application.ScreenUpdating = True

Application.CutCopyMode = False
Workbooks("Remittance Module.xls").Activate

End Sub

 

[Ron de Bruin]

Hi Edgar

Try to adapt the second example.
This use Advanced filter

http://www.rondebruin.nl/copy5.htm