Select ,copy paste and print sepratly.

Hi ,Team

I am trying to copy 1 cp name ,sr no 01 ,sr no 02 and qty in seprate sheet with header and print it with specific size.
any help with vba code much appriciate .

Thanks in advance i have attached excel sheet.

Little Bump.

Hi visha

Try this

Option Explicit

Sub Sep_Print()
  Dim ws As Worksheet, ws1 As Worksheet, ws2 As Worksheet
  Dim LR As Long, LC As Long
  Dim cel As Range

  Set ws = Sheets("Sheet1")

  Application.ScreenUpdating = False
  If Not Evaluate("ISREF(Lists!A1)") Then
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Lists"
  Else
    Sheets("Lists").Cells.ClearContents
  End If

  Set ws1 = Sheets("Lists")

  With ws
    LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                     SearchDirection:=xlPrevious).Row
    LC = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
                     SearchDirection:=xlPrevious).Column
    .Range("A1:A" & LR).AdvancedFilter Action:=xlFilterCopy, _
                                       CopyToRange:=ws1.Range("A1"), Unique:=True

    ActiveWorkbook.Names.Add Name:="CPName", RefersTo:= _
                             "=OFFSET(Lists!$A$2,0,0,(COUNTA(Lists!$A:$A)-1),1)"

    If Not Evaluate("ISREF(Temp!A1)") Then
      Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Temp"
    Else
      Sheets("Temp").Cells.ClearContents
    End If
    Set ws2 = Sheets("Temp")
    For Each cel In Range("CPName")
      .Range("A1:D" & LR).AutoFilter Field:=1, Criteria1:=cel.Value
      With .Range(.Cells(1, 1), .Cells(LR, LC)).SpecialCells(xlCellTypeVisible).Copy
        With ws2
          .Range("A1").PasteSpecial (xlPasteColumnWidths)
          .Range("A1").PasteSpecial (xlPasteValues)
          .PrintPreview  '<---Change to .PrintOut to print Sheet
          .Cells.Clear
        End With
        ws.ShowAllData
      End With
    Next cel

  End With
  Application.DisplayAlerts = False
  ws2.Delete
  ws1.Delete
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

Hi visha

Click the Button in the attached...works for me...

Hi visha

Change the indicated Line of Code

For Each cel In Range("CPName")
      .Range("A1:D" & LR).AutoFilter Field:=1, Criteria1:=cel.Value
      With .Range(.Cells(1, 1), .Cells(LR, LC)).SpecialCells(xlCellTypeVisible).Copy
        With ws2
          .Range("A1").PasteSpecial (xlPasteColumnWidths)
          .Range("A1").PasteSpecial (xlPasteValues)
          .PrintPreview  '<---Change to .PrintOut
          .Cells.Clear
        End With
        ws.ShowAllData
      End With
    Next cel