consolidate lot details

Option Explicit
Sub test()
   Dim ws1          As Worksheet
   Dim ws2          As Worksheet
   Dim ws3          As Worksheet
   Dim Rng2         As Range
   Dim Rng3         As Range
   Dim cel2         As Range
   Dim cel3         As Range
   Dim LR2          As Long
   Dim x            As Long
   Dim i            As Long
   Dim j            As Long
   Dim myQty        As String
   Dim Cnt          As Long
   Set ws1 = Sheet1
   Set ws2 = Sheet2
   Application.ScreenUpdating = False
   If Not Evaluate("ISREF(Output!A1)") Then
      Worksheets.Add(After:=Sheet2).Name = "Output"
   Else
      Sheets("Output").Cells.Clear
   End If
   Set ws3 = Sheets("Output")
   ws1.Cells.Copy ws3.Range("A1")
   Cnt = 1
   With ws2
      If Not .AutoFilterMode Then
         .Rows("1:1").AutoFilter
      End If
      .Columns("F:F").ClearContents
      .Range("F1").Value = "Grp"
      LR2 = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious).Row
      Set Rng2 = .Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
      .Range("F2").Value = Cnt
      
      For Each cel2 In Rng2
         If cel2.Value = cel2.Offset(1, 0).Value _
         And cel2.Offset(0, 1).Value = cel2.Offset(1, 1).Value Then
            .Cells(cel2.Row, "F").Offset(1, 0) = Cnt
         ElseIf Not cel2.Offset(1, 0).Value = "" Then
            Cnt = Cnt + 1
            .Cells(cel2.Row, "F").Offset(1, 0) = Cnt
         Else
         End If
      Next cel2
      
      ws2.Rows("1:1").AutoFilter
   End With
   myQty = ""
   With ws3
      .Cells(1, "G").Value = "Lot No.-Qty"
      .Cells(1, "H").Value = "Grp"
      i = .Range("C:C").Cells.SpecialCells(xlCellTypeConstants).Count - 1
      For j = 1 To i
         .Cells(j + 1, "H") = j
      Next j
      Set Rng3 = .Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
      For Each cel3 In Rng3
         ws2.Range("A1:H" & LR2).AutoFilter Field:=2, Criteria1:=cel3.Value
         ws2.Range("A1:H" & LR2).AutoFilter Field:=3, Criteria1:=cel3.Offset(0, 1).Value
         ws2.Range("A1:H" & LR2).AutoFilter Field:=6, Criteria1:=cel3.Offset(0, 6).Value
         x = ws2.AutoFilter.Range.Columns(2).SpecialCells(xlCellTypeVisible).Count - 1
         Cnt = 0
         With ws2
            For Each cel2 In .Range("E2:E" & .Cells(.Rows.Count, "E").End(xlUp).Row) _
                .SpecialCells(xlCellTypeVisible)
               Cnt = Cnt + 1
               If Cnt < x Then
                  myQty = myQty & cel2.Value & "-" & cel2.Offset(0, -1).Value & ";"
               Else
                  myQty = myQty & cel2.Value & "-" & cel2.Offset(0, -1).Value
                  ws3.Cells(cel3.Row, "G").Value = myQty
                  myQty = ""
               End If
            Next cel2
         End With
      Next cel3
      ws2.AutoFilterMode = False
   End With
      ws2.Range("F:F").EntireColumn.Delete
      ws3.Range("H:H").EntireColumn.Delete
      ws3.Columns.AutoFit
      Application.ScreenUpdating = True
End Sub