Copy selection range and paste in a specific sheet

[Unexpc]

Hi guys
i want when i select a range, after that with run a macro, doing this 3 steps
Paste in a sheet that named Sheet from cell A3
after that print from a sheet that named Print
after that clear contents from A3 until rows of sheet that named Sheet be ended...

 

[Unexpc]

Problem 1 & 2 Solved.
About Problem 3 , I told Before you should copy all of data ( & formula that seen empty) at Print Sheet page 2 to other pages (3 & after) to See result otherwise all of selected range don't show at print page and because of it you see empty pages.

Option Explicit
Sub CopyPaste()
Dim ShP As Worksheet, SrRange As Range, i As Long, k As Long, L As Long
Dim MyRange As Range, ws As Worksheet, Lastrow As Long, n As Long, j As Long
Dim PrintArea As String, FC As Long, LC As Long, Fr As Long, Lr As Long, Y As Long
Application.ScreenUpdating = False
Set ShP = Worksheets("Sheet")
Set SrRange = Selection
FC = SrRange.Column
LC = SrRange.Columns.Count
Fr = SrRange.Row
Lr = SrRange.Rows.Count + Fr - 1
Y = Fr - SrRange.Rows.Count
k = Fr + Application.WorksheetFunction.CountBlank(Range(Cells(Fr, FC), Cells(Lr, FC)))
For i = Fr To 1 Step -1
If Cells(i, FC).Interior.Color = 4697456 And Cells(i, FC).Value <> "" Then
ShP.Range("A1").Value = Cells(i, FC).Value
If Fr = i Then
k = Fr + 2
Else
k = Fr
End If
GoTo Resum
End If
Next i
Resum:
For i = Fr To Lr
If Cells(i, FC).Interior.Color = 4697456 And Cells(i, FC).Value <> "" Then
If i > Fr Then
ShP.Cells(3 + i - k, 1).Value = Cells(i, FC).Value
End If
ElseIf Cells(i, FC + 1).Value <> "" Then
Range(ShP.Cells(3 + i - k, 2), ShP.Cells(3 + i - k, 1 + LC - FC)).Value = Range(Cells(i, FC + 1), Cells(i, LC)).Value
End If
Next i
L = i - 1
Set ws = ShP
j = ShP.Index
Sheets(j + 1).Visible = True
Sheets(j + 1).Select
n = Int((L - Fr + 1) / 32) + 1
Sheets(j + 1).PageSetup.PrintArea = Sheets(j + 1).Range("A1:H" & n * 34 + 6).Address
Printing: ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="Print " & ShP.Range("A1").Value _
  , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
   :=False, OpenAfterPublish:=True
Sheets(j + 1).Visible = False
Sheets(j - 1).Select
ShP.Range("A1:A2").ClearContents
On Error Resume Next
Range(ShP.Cells(3, 2), ShP.Cells(L, 1 + LC - FC)).MergeArea.ClearContents
Range(ShP.Cells(3, 1), ShP.Cells(L, 1 + LC - FC)).ClearContents
Application.ScreenUpdating = True
End Sub

1&3 Solved (THANK YOU), little thing, after print going the sheet before Sheet not attend in sheet that copied data

 

[Unexpc]

im not understand about copy/paste page 2 in page 3&... please explain more
because when i use your last code print 3 pages but page 3 is empty
the code i have about this copy/paste your solution code that when cell 67 is fill, copy paste page 2 and 3 is working, and when cell 99 is fill, doing this function about page 3 and page 4 &...

 

[maabadi]

About Select Uncorrect Sheet I change code Again.
About Problem 3 your worksheet Change event when working that data added to your sheet Cell by Cell not Pasting Row onto it then All target.Count & Target value at that sheet should e deleted.
Your Revised Code:

Sub CopyPaste()
Dim ShP As Worksheet, DSheet As Worksheet, SrRange As Range, i As Long, k As Long, L As Long
Dim MyRange As Range, ws As Worksheet, Lastrow As Long, n As Long, j As Long
Dim PrintArea As String, FC As Long, LC As Long, Fr As Long, Lr As Long, Y As Long
Application.ScreenUpdating = False
Set ShP = Worksheets("Sheet")
Set DSheet = ActiveSheet
Set SrRange = Selection
FC = SrRange.Column
LC = SrRange.Columns.Count
Fr = SrRange.Row
Lr = SrRange.Rows.Count + Fr - 1
Y = Fr - SrRange.Rows.Count
k = Fr + Application.WorksheetFunction.CountBlank(Range(Cells(Fr, FC), Cells(Lr, FC)))
For i = Fr To 1 Step -1
If Cells(i, FC).Interior.Color = 4697456 And Cells(i, FC).Value <> "" Then
ShP.Range("A1").Value = Cells(i, FC).Value
If Fr = i Then
k = Fr + 2
Else
k = Fr
End If
GoTo Resum
End If
Next i
Resum:
For i = Fr To Lr
If Cells(i, FC).Interior.Color = 4697456 And Cells(i, FC).Value <> "" Then
If i > Fr Then
ShP.Cells(3 + i - k, 1).Value = Cells(i, FC).Value
End If
ElseIf Cells(i, FC + 1).Value <> "" Then
Range(ShP.Cells(3 + i - k, 2), ShP.Cells(3 + i - k, 1 + LC - FC)).Value = Range(Cells(i, FC + 1), Cells(i, LC)).Value
End If
Next i
L = i - 1
Set ws = ShP
j = ShP.Index
Sheets(j + 1).Visible = True
Sheets(j + 1).Select
n = Int((L - Fr + 1) / 32) + 1
Sheets(j + 1).PageSetup.PrintArea = Sheets(j + 1).Range("A1:H" & n * 34 + 6).Address
Printing: ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="Print " & ShP.Range("A1").Value _
  , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
   :=False, OpenAfterPublish:=True
Sheets(j + 1).Visible = False
ShP.Range("A1:A2").ClearContents
On Error Resume Next
Range(ShP.Cells(3, 2), ShP.Cells(L, 1 + LC - FC)).MergeArea.ClearContents
Range(ShP.Cells(3, 1), ShP.Cells(L, 1 + LC - FC)).ClearContents
DSheet.Select
Application.ScreenUpdating = True
End Sub

AND Your Modified Worksheet Change Event Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
    If Target.Column = 2 And Target.Row >= 67 Then
        If (Target.Row - 35) Mod 32 = 0 Then
                lRow = (((Target.Row - 35) * 34) / 32) + 7
                With ThisWorkbook.Sheets("Print")
                    .Range("A" & lRow & ":H" & lRow + 33).Copy .Range("A" & lRow + 34)
                    Sheets("Print").Visible = False
                    Application.ScreenUpdating = True
                    Application.EnableEvents = True
                End With
            End If
        End If
End Sub

 

[Unexpc]

THANK YOU FOR HARD WORKING LIKE ALWAYS

 

[maabadi]

You're Welcome & Thanks for follow-up

 

[maabadi]

What is Problem with Modified worksheet change event I posted at previous post?

 

[Unexpc]

What is Problem with Modified worksheet change event I posted at previous post?

i insert in visual code window of Print, but i not understand until now how does it run, generally i want when i run code copy/paste, modified worksheet change event working with that and i test this, but still page 3 is empty, if i wrong please what am i do

 

[maabadi]

Why for Print? You should change worksheet change event at Sheet worksheet.

 

[Unexpc]

Why for Print? You should change worksheet change event at Sheet worksheet.

why me wrong, this is solved, THANK YOUUU

 

[Unexpc]

please add in code that after print, delete pages after page 2 in Print THANK YOU