Try this
Sub CopyAmdPaste()

  Dim C As Long
  Dim Col As Object
  Dim DstRng As Range
  Dim R As Long
  Dim RngRow As Range
  Dim SrcRng As Range
  
    Set SrcRng = Worksheets("Sheet1").Range("New_Range2")
    Set DstRng = Worksheets("Sheet2").Range("A1")
    
    Application.ScreenUpdating = False
    
     'Copy all non empty rows to the destination range
      For Each RngRow In SrcRng.Rows
        If WorksheetFunction.CountA(RngRow) <> 0 Then
           RngRow.Copy 
           DstRng.Offset(R, 0).pastespecial(xlpastevalues)
           R = R + 1
        End If
      Next RngRow
      
      Set DstRng = DstRng.Resize(R, SrcRng.Columns.Count)
      
       'Remove all empty columns except "B"
        For C = DstRng.Columns.Count To 3 Step -1
          Set Col = DstRng.Columns(C)
          If WorksheetFunction.CountA(Col.Cells) = 0 Then
             Col.EntireColumn.Delete
          End If
        Next C
        
    Application.ScreenUpdating = True
    
End Sub