speeding up code that is super slow

The code below is part of a much larger spreadsheet that I wrote using help from this site, since I have 0 prior experience. I know it is full of useless, slow, code, but until I can get someone to rewrite it completely, it's all I have to work with.

My problem is that the code below is extremely slow to process. Basically, it grabs info from another sheet that has a possibility of having 500 lines of part numbers. There are never that many on one order, more like 40-50, but I don't know how to copy just the used cells, so I copy all visible cells in the 500 line range, after it has been autofiltered. I then paste that entire range. There are a lot of merged cells that contain data on the original sheet, but are not used on this one, so I do a lot of unmerging and merging (which I think is what's taking up all the time)

If someone can look at this and give me some pointers as to how I can speed up this process, I would appreciate it greatly. Right now, it takes about 30 seconds or so to run.

Thanks in advance for ALL of the help thus far and in the future, I'm sure.

Private Sub CommandButton1_Click()

'populate top of traffic sheet
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim ws4 As Worksheet

Set ws1 = Sheets("Cover Sheet")
Set ws2 = Sheets("Quote")
Set ws3 = Sheets("Order Form")
Set ws4 = Sheets("Traffic")

'opportunity name
ws2.Range("C6").Copy Destination:=ws4.Range("B3")
'original order date
ws3.Range("G4").Copy Destination:=ws4.Range("C3")
'insert vendor initials onto traffic sheet
Dim a As String
a = ws2.Range("G12")
a = Left(a, 2)
ws4.Range("D3") = a
'insert rep
ws2.Range("C11").Copy Destination:=ws4.Range("E3")
'received

'# parts
ws2.Range("A503").Copy Destination:=ws4.Range("H3")
'Drop
ws1.Range("C48").Copy Destination:=ws4.Range("I3")
'P/U
ws1.Range("C49").Copy Destination:=ws4.Range("J3")
'Flat
ws1.Range("C50").Copy Destination:=ws4.Range("K3")
'Assembly
ws1.Range("C51").Copy Destination:=ws4.Range("L3")
'Mods
ws1.Range("C52").Copy Destination:=ws4.Range("K3")
'Delivery
ws1.Range("C53").Copy Destination:=ws4.Range("O3")
'Installation
ws1.Range("C54").Copy Destination:=ws4.Range("Q3")

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'create traffic sheet

ws2.Range("A6:F10").Copy Destination:=ws4.Range("A4:F8")
ws2.Range("G13").Copy Destination:=ws4.Range("G8")
ws2.Activate
ActiveSheet.Unprotect
ws4.Range("C9:G500").UnMerge
ws2.Range("A14:B500").Copy Destination:=ws4.Range("A9")
ws2.Range("E14:F500").Copy Destination:=ws4.Range("C9")
ws4.Range("H6:J8").Merge
ws4.Range("H6") = ws4.Range("D3")

ws4.Range("B9").Value = "PARTS"
ws4.Range("A9") = ws4.Range("H3").Font.Size = 26

'merge C - G
For i = 9 To 500
Application.DisplayAlerts = False
ws4.Range("C" & i & ":G" & i).MergeCells = True
Next i
'unmerge bottom of sheet
ws4.Range("C57:G58").UnMerge
Application.DisplayAlerts = True

'populate bottom of sheet
ws4.Range("A57:H58").HorizontalAlignment = xlCenter

'cell outlines
ws4.Range("A57:J58").Borders(xlEdgeLeft).LineStyle = xlContinuous
ws4.Range("A57:J58").Borders(xlEdgeRight).LineStyle = xlContinuous
ws4.Range("A57:J58").Borders(xlEdgeBottom).LineStyle = xlContinuous
ws4.Range("A57:J58").Borders(xlEdgeTop).LineStyle = xlContinuous
ws4.Range("A57:J58").Borders(xlInsideVertical).LineStyle = xlContinuous
ws4.Range("A57:J58").Borders(xlInsideHorizontal).LineStyle = xlContinuous
ws4.Range("A9:J9").Borders(xlEdgeTop).LineStyle = xlContinuous
ws4.Range("A4:J4").Borders(xlEdgeTop).LineStyle = xlContinuous
ws4.Range("A4:A8").Borders(xlEdgeLeft).LineStyle = xlContinuous
ws4.Range("J6:J8").Borders(xlEdgeRight).LineStyle = xlContinuous
ws4.Range("A9:J9").Borders(xlEdgeBottom).LineStyle = xlContinuous

'bottom of page population
ws4.Range("A57").Value = "DROP"
ws4.Range("A58") = ws4.Range("I3")
ws4.Range("B57").Value = "PICK UP"
ws4.Range("B58") = ws4.Range("J3")
ws4.Range("C57").Value = "FLAT"
ws4.Range("C58") = ws4.Range("K3")
ws4.Range("D57").Value = "ASSY"
ws4.Range("D58") = ws4.Range("L3")
ws4.Range("E57:F57").MergeCells = True
ws4.Range("E58:F58").MergeCells = True
ws4.Range("E57").Value = "DELIVERY"
ws4.Range("E58") = ws4.Range("O3")
ws4.Range("G57").Value = "MODIFICATIONS"
ws4.Range("G58") = ws4.Range("N3")
ws4.Range("H57:J57").MergeCells = True
ws4.Range("H58:J58").MergeCells = True
ws4.Range("H57").Value = "INSTALLATION"
ws4.Range("H58") = ws4.Range("Q3")


'print to traffic printer
Application.ActivePrinter = "\\traffic\Traffic on Ne11:"

    ws4.PageSetup.PrintArea = "$A$4:$J$58"
    ws4.PrintOut Copies:=1






Application.ScreenUpdating = False
 'Traffic - My Computer
    Sheets("Traffic").Select
    Sheets("traffic").Range("A3:Y3").Select
    Selection.Copy
    Windows("traffic.xlsm").Activate
    Sheets("traffic").Range("A65536:Y65536").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveSheet.Paste
    
    ActiveWorkbook.Save
    'ActiveWindow.Close


End Sub