Sub ExpandRows()
  Dim a As Variant, vals As Variant
  Dim i As Long, rws As Long
  
  Application.ScreenUpdating = False
  With Range("A3:B" & Range("A" & Rows.Count).End(xlUp).Row)
    a = .Columns(2).Value2
    For i = UBound(a) To 1 Step -1
     ' vals = Split(Mid(a(i, 1), 2, Len(a(i, 1)) - 2), ",")
       vals = Split(a(i, 1), ",")
      rws = UBound(vals) + 1
      If rws > 1 Then
        .Rows(i + 1).Resize(rws - 1).Insert
        .Rows(i).Copy Destination:=.Rows(i).Resize(rws)
      End If
   .Cells(i, 2).Resize(rws).Value = Application.Transpose(vals)
   ' .Cells(i, 13).Resize(rws).Value = Destination.Resize(UBound(vals, 2) + 1, UBound(vals, 1) + 1) = Application.Transpose(vals)
   
     
    Next i
  End With
  Application.ScreenUpdating = True
  End Sub

  a = Range(.[w2], .Range("W" & iLastrow)).Value

Sub Macro4()


Dim a, b, c, iLastrow As Long, i As Long, ii As Long
 

   Selection.AutoFilter Field:=1, Criteria1:="add4"

   
    With Worksheets("Proj1")
   
        iLastrow = .Cells(Rows.Count, 23).End(xlUp).Row
        a = Range(.[w2], .Range("W" & iLastrow)).Value
 
         
    End With

    With Worksheets("base")
        iLastrow = .Cells(Rows.Count, 5).End(xlUp).Row 
       b = Range(.[e2], .Range("Y" & iLastrow)).Value 
     
    End With

    
    ReDim c(1 To UBound(a), 1 To 20)

    With CreateObject("Scripting.Dictionary")
    
    
        For i = 1 To UBound(b)
            .Item(b(i, 1)) = i
        Next

       
           For i = 1 To UBound(a)
           
            If .exists(a(i, 1)) Then
                c(i, 1) = b(.Item(a(i, 1)), 2)
                c(i, 2) = b(.Item(a(i, 1)), 3)
                c(i, 3) = b(.Item(a(i, 1)), 4)
                c(i, 4) = b(.Item(a(i, 1)), 5)
                c(i, 5) = b(.Item(a(i, 1)), 6)
                c(i, 6) = b(.Item(a(i, 1)), 7)
                c(i, 7) = b(.Item(a(i, 1)), 8)
                c(i, 8) = b(.Item(a(i, 1)), 9)
                c(i, 9) = b(.Item(a(i, 1)), 10)
                c(i, 10) = b(.Item(a(i, 1)), 11)
                c(i, 11) = b(.Item(a(i, 1)), 12)
                c(i, 12) = b(.Item(a(i, 1)), 13)
                c(i, 13) = b(.Item(a(i, 1)), 14)
                c(i, 14) = b(.Item(a(i, 1)), 15)
                c(i, 15) = b(.Item(a(i, 1)), 16)
                c(i, 16) = b(.Item(a(i, 1)), 17)
                c(i, 17) = b(.Item(a(i, 1)), 18)
                c(i, 18) = b(.Item(a(i, 1)), 19)
                c(i, 19) = b(.Item(a(i, 1)), 20)
                c(i, 20) = b(.Item(a(i, 1)), 21)
            
            End If
        Next
    End With

    With Worksheets("Proj1")   
   
        .[x2].Resize(UBound(c), 20) = c 
        .Activate
    End With

 
End Sub