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]

But I test and work for me. please upload your example file.

with example file is work correctly but with main file have problem, i try but i don't know why not work with main file (two file have same code) please wait...

 

[Unexpc]

this error is show

 

[Unexpc]

But I test and work for me. please upload your example file.

i think i should remove all customer and insert customers again, i test with this method and is work, i don't know why but i think i have to do this,
just two question
1, sometime error this issue #132
2, copy format cell for two cell in Print, for C4 give first format cell i select for copy (first row selected for print, give that format cell date for C4) and for G4 end format cell of selected rows for copy from source sheet

 

[Unexpc]

i tried for several times, again i think should remove customers and insert again, but #132 error happened for sometimes this about column width? or?

 

[maabadi]

For Error Change both J to K at this:

For J = 1 To 3
        .ColumnWidth = 60 / .Width * .ColumnWidth
    Next J

 

[Unexpc]

For Error Change both J to K at this:

For J = 1 To 3
        .ColumnWidth = 60 / .Width * .ColumnWidth
    Next J

yes, and please say what about two cell?
and about column width changed, how can i change that in code your send or not changed at all? because after that doing code column width is changed

 

[Unexpc]

two cell is give specific cell from source cell, C4 is give first format cell selected and G4 is give end format cell selected

 

[maabadi]

About Format C4 and G4, Please Clarify exactly, you want C4 format for Column A at print Sheet or ... Also for G4
At this code, I try to copy format from Column B of source sheet to Column A of print sheet , Page by Page.
I add changing column Width because when I test other format, I see last column maybe go to another page, if you don't need it, you can remove it. then test this:

Sub PageForPrint()
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, P As String
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
ActiveSheet.Range("B" & Fr & ":B" & Lr).Copy
ShP.Range("B3:B" & 2 + i - K).PasteSpecial Paste:=xlPasteFormats
L = i - 1
Set ws = ShP
J = ShP.Index
Sheets(J + 1).Visible = True
Sheets(J + 1).Select
N = Int((L - Fr - 0) / 32) + 1
For i = 1 To N
If SrRange.Rows.Count > i * 32 Then
Sheets(J).Range("B" & Fr + (i - 1) * 32 & ":B" & Fr + i * 32 - 1).Copy
Sheets(J + 1).Range("A" & (i - 1) * 34 + 8 & ":A" & i * 34 + 5).PasteSpecial Paste:=xlPasteFormats
Sheets(J + 1).Range("A" & (i - 1) * 34 + 8 & ":A" & i * 34 + 5).Font.Size = 11
Else
Sheets(J).Range("B" & Fr + (i - 1) * 32 & ":B" & Fr + (i - 1) * 32 + SrRange.Rows.Count - (i - 1) * 32).Copy
Sheets(J + 1).Range("A" & (i - 1) * 34 + 8 & ":A" & (i - 1) * 34 + 8 + SrRange.Rows.Count - (i - 1) * 32).PasteSpecial Paste:=xlPasteFormats
Sheets(J + 1).Range("A" & (i - 1) * 34 + 8 & ":A" & (i - 1) * 34 + 8 + SrRange.Rows.Count - (i - 1) * 32).Font.Size = 11
End If
Next i
Sheets(J + 1).PageSetup.PrintArea = Sheets(J + 1).Range("A1:H" & N * 34 + 6).Address
Debug.Print Err.Number
Resum3:
On Error Resume Next
Printing: ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="Print " & ShP.Range("A1").Value & P _
  , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
   :=False, OpenAfterPublish:=True
 
If Err.Number <> 0 Then GoTo ErrorHandler

Sheets(J + 1).Visible = True
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
If N > 2 Then Sheets(J + 1).Range("A75:H" & N * 34 + 10).EntireRow.Delete
DSheet.Select
Application.ScreenUpdating = True
Exit Sub
ErrorHandler:
If P = "" Then
P = "(" & 1 & ")"
Else
P = "(" & Mid(P, 2, 1) + 1 & ")"
End If
Err.Number = 0
GoTo Resum3
End Sub

 

[Unexpc]

About Format C4 and G4, Please Clarify exactly, you want C4 format for Column A at print Sheet or ... Also for G4

for example for this photo, i select 8:10, i mean for C4 copy format cell from 8 and for G4 copy format cell from 10
(format cell from Column B)
for each row i select, give first format cell (that i selected) for C4 and end format cell (that i selected) for G4

 

[Unexpc]

I add changing column Width because when I test other format, I see last column maybe go to another page, if you don't need it, you can remove it. then test this:

yes, thank you for editing, and i think for font that is happened for you