Any idea to make this code work faster ( copy and paste data )

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

setting the screenupdating to false at the beginning and then reversing it at the end
in the beginning of the code

With application
.screenupdating =false
.displayalerts=false
.enableevents=false
end with

you may also set the calculation to manuall at the beginning and the to automatic in similar fassion if your sheet is full of formulas that are calculated after every operation.
at the end of the code before end sub key word

With application
.screenupdating =true
.displayalerts=true
.enableevents=true
end with

One of the reasons your code is running slowly is that you are copying and pasting several columns separately and repeating the same process many times
Copy/Paste copies only filtered rows - so I have not included specialcells in the code

Instead of copying and pasting in bits
- firstly copy and paste the whole of the data values range to a temporary sheet
- then instead of copying and pasting each column, attribute the values instead

I am guessing that you have filter headers in row 7 and that you are copying all your filtered data range - if not
replace this in the code below

sh1.Range("A7").CurrentRegion.Copy

with

sh1.Range("A8:J391").Copy

and the Resize becomes Resize(lr) instead of Resize(lr - 1)


Create a temporary sheet and name it "Temp" and try replacing everything in your code below line On Error Resume Next (which you should no longer require)

Dim temp As Worksheet, lr As Long
Set temp = Sheets("Temp")

temp.Range("A1").PasteSpecial (xlPasteValues)
lr = temp.Range("A" & Cells.Rows.Count).End(xlUp).Row

With temp
   
   Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Resize(lr - 1) = .Range("I2:I" & lr).Value
   Range("D" & Rows.Count).End(xlUp).Offset(1, 0).Resize(lr - 1) = .Range("C2:C" & lr).Value
   Range("E" & Rows.Count).End(xlUp).Offset(1, 0).Resize(lr - 1) = .Range("H2:H" & lr).Value
   Range("M" & Rows.Count).End(xlUp).Offset(1, 0).Resize(lr - 1) = .Range("D2:E" & lr).Value
   Range("H" & Rows.Count).End(xlUp).Offset(1, 0).Resize(lr - 1) = .Range("F2:F" & lr).Value
   Range("J" & Rows.Count).End(xlUp).Offset(1, 0).Resize(lr - 1) = .Range("G2:G" & lr).Value
   Range("L" & Rows.Count).End(xlUp).Offset(1, 0).Resize(lr - 1) = .Range("J2:J" & lr).Value
End With

And do not forget to include ImranBhatti's suggestions - which avoid the sheet being recalculated and the display refreshed every time a value is changed by VBA

This will not make much difference to speed but by adding a variable, the code can be simplified on the 7 rows where the values are being attributed

create variable to find the next row

dim fr as long
fr = Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Row

then

Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Resize(lr - 1)
Range("D" & Rows.Count).End(xlUp).Offset(1, 0).Resize(lr - 1)

is simplified to

Range("C" & fr).Resize(lr - 1)
Range("D" & fr).Resize(lr - 1)
etc