Help with VBA to copy and paste from sheets contained in a list

Sub CopyDataToSummary()
Dim ws As Worksheet, dws As Worksheet, admWs As Worksheet
Dim lr As Long, alr As Long, i As Long, dlr As Long
Dim x
Application.ScreenUpdating = False
Set dws = Sheets("Summary")
Set admWs = Sheets("Admin")
dws.Cells.Clear
dws.Range("C5:D5").Value = Array("Code", "Sales")
alr = admWs.Cells(Rows.Count, 2).End(xlUp).Row
If alr < 8 Then
   MsgBox "There are no sheets listed on Admin Sheet.", vbExclamation, "Sheet List Not Found!"
   Exit Sub
End If
x = admWs.Range("B8:B" & alr).Value
For i = 1 To UBound(x, 1)
   On Error Resume Next
   Set ws = Sheets(x(i, 1))
   If Not ws Is Nothing Then
      lr = ws.Cells(Rows.Count, 8).End(xlUp).Row
      If lr > 5 Then
         ws.Range("H6:I" & lr).Copy dws.Range("C" & Rows.Count).End(3)(2)
      End If
   End If
Next i
Application.ScreenUpdating = True
MsgBox "Data has been copied to Summary Sheet successfully.", vbInformation, "Done!"
End Sub

Select allOpen in new window