Cakz Primz
Board Regular
- Joined
- Dec 4, 2016
- Messages
- 102
- Office Version
- 365
- Platform
- Windows
Dear All,
I am using Office 365, and I need to filter, copy visible only from one book to another workbook.
The data source is around 35,000 rows, from column A to AK.
With the code below, it runs "painfully" slow to copy the filtered range, visible cell only and paste it onto another workbook.
I need your expertise suggestions to find the solution.
I do really hope that someone could help me.
Thank you very much, really appreciate for your time.
I am using Office 365, and I need to filter, copy visible only from one book to another workbook.
The data source is around 35,000 rows, from column A to AK.
With the code below, it runs "painfully" slow to copy the filtered range, visible cell only and paste it onto another workbook.
I need your expertise suggestions to find the solution.
VBA Code:
Sub CopyPaste()
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.DisplayStatusBar = False
Windows("RFM Log.xlsx").Activate
Dim wb As Workbook: Set wb = ThisWorkbook
Dim twb As Workbook
Dim ws As Worksheet
Dim tws As Worksheet
Set wb = Workbooks("RFM.xlsx") 'source workbook
Set ws = wb.Sheets("RFM - Register") 'source worksheet
Set twb = Workbooks("PO.xlsb") 'target workbook
Set tws = twb.Sheets("RFM Reg") 'target worksheet
Dim lRow As Long
lRow = Cells(Rows.Count, 1).End(xlUp).Row
With ws
.Range("A2:AK" & lRow).AutoFilter Field:=4, Criteria1:="1", Operator:=xlFilterValues
.Range("A3:B" & lRow).SpecialCells(xlCellTypeVisible).Copy
With tws
.Range("A3").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
End With
Set rng = tws.Range("D3:D50000")
With ws
.Range("D3:D50000").SpecialCells(xlCellTypeVisible).Copy
With tws
.Range("C3").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
End With
With ws
.Range("H3:J50000").SpecialCells(xlCellTypeVisible).Copy
With tws
.Range("D3").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
End With
With ws
.Range("N3:Q50000").SpecialCells(xlCellTypeVisible).Copy
With tws
.Range("G3").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
End With
With ws
.Range("S3:AG50000").SpecialCells(xlCellTypeVisible).Copy
With tws
.Range("K3").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
End With
With ws
.Range("AK3:AK50000").SpecialCells(xlCellTypeVisible).Copy
With tws
.Range("Z3").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
End With
wb.Close savechanges:=False
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.DisplayStatusBar = True
End With
End SubI do really hope that someone could help me.
Thank you very much, really appreciate for your time.
