hi,
i am using this code to copy data and paste another sheet
but its working very slowly, please any idea to make this faster code
Sub ExcelToTallyAll4444()
Dim LR As Long
LR = Range("A" & Rows.count).End(xlUp).row
Dim sh1 As Worksheet
Set sh1 = ActiveWorkbook.Worksheets("SUMALL")
Dim WB As Workbook
On Error Resume Next
Set WB = Workbooks("Vouchers - Purchase Transactions With StockItems.XLSM")
On Error GoTo 0
If WB Is Nothing Then
Workbooks.Open Filename:="Z:\42766\Excel To Tally\Purchases\Vouchers - Purchase Transactions With StockItems.XLSM"
Else
WB.Activate
End If
On Error Resume Next
With sh1
.Range("I8:I391").SpecialCells(xlCellTypeVisible).Copy
Range("C" & Rows.count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
.Range("C8:C391").SpecialCells(xlCellTypeVisible).Copy
Range("D" & Rows.count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
.Range("H8:H391").SpecialCells(xlCellTypeVisible).Copy
Range("E" & Rows.count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
.Range("D8:E391").SpecialCells(xlCellTypeVisible).Copy
Range("M" & Rows.count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
.Range("F8:F391").SpecialCells(xlCellTypeVisible).Copy
Range("H" & Rows.count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
.Range("G8:G391").SpecialCells(xlCellTypeVisible).Copy
Range("J" & Rows.count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
.Range("J8:J391").SpecialCells(xlCellTypeVisible).Copy
Range("L" & Rows.count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False
End Sub
Bookmarks