Copy selection range and paste in a specific sheet

U

Unexpc

Active Member
Joined
Nov 12, 2020
Messages
496
Office Version
  1. 2019
Platform
  1. Windows
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...
 
Sort by date Sort by votes
maabadi said:
How about:
VBA Code: 
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, NF As String
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
ActiveSheet.Range("B" & Fr).Copy
ShP.Range("C4").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
With Sheets(J + 1)
 DSheet.Range("B" & Fr).Copy
.Range("C4").PasteSpecial Paste:=xlPasteFormats
 DSheet.Range("B" & Lr).Copy
.Range("G4").PasteSpecial Paste:=xlPasteFormats
.Range("C4:G4").Interior.Color = .Range("D4").Interior.Color
.Range("C4:G4").Font.Size = .Range("D4").Font.Size
.Range("C4:G4").Font.Name = .Range("D4").Font.Name
.PageSetup.PrintArea = .Range("A1:H" & N * 34 + 6).Address
End With
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
Click to expand...
yes, solved, and just a thing
Unexpc said:
mabaadi something is wrong, please print test customer from Row 4 to 6 and see print pdf, not correct replaced format cell
example file : Book T=Ts.rar
Click to expand...
 
Upvote 0

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
I check. this is because of your Custom Number format and, I don't have good experience with that. please take help from others.
 
Upvote 0
Also Try this. if you see again spliting print area to 2 page then we should add column autofit to one of columns can be smaller width.
VBA Code: 
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, NF As String
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 - 0) / 32) + 1
For i = 1 To N
If SrRange.Rows.Count > i * 32 Then
DSheet.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
DSheet.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
With Sheets(J + 1)
 DSheet.Range("B" & Fr).Copy
.Range("C4").PasteSpecial Paste:=xlPasteFormats
 DSheet.Range("B" & Lr).Copy
.Range("G4").PasteSpecial Paste:=xlPasteFormats
.Range("C4:G4").Interior.Color = .Range("D4").Interior.Color
.Range("C4:G4").Font.Size = .Range("D4").Font.Size
.Range("C4:G4").Font.Name = .Range("D4").Font.Name
.PageSetup.PrintArea = .Range("A1:H" & N * 34 + 6).Address
End With
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
 
Upvote 0
maabadi said:
Also Try this. if you see again spliting print area to 2 page then we should add column autofit to one of columns can be smaller width.
VBA Code: 
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, NF As String
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 - 0) / 32) + 1
For i = 1 To N
If SrRange.Rows.Count > i * 32 Then
DSheet.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
DSheet.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
With Sheets(J + 1)
 DSheet.Range("B" & Fr).Copy
.Range("C4").PasteSpecial Paste:=xlPasteFormats
 DSheet.Range("B" & Lr).Copy
.Range("G4").PasteSpecial Paste:=xlPasteFormats
.Range("C4:G4").Interior.Color = .Range("D4").Interior.Color
.Range("C4:G4").Font.Size = .Range("D4").Font.Size
.Range("C4:G4").Font.Name = .Range("D4").Font.Name
.PageSetup.PrintArea = .Range("A1:H" & N * 34 + 6).Address
End With
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
Click to expand...
yes it solved and actually work :D just a little problem, when i select till gray row, this happened
 

Attachments

  • image_2021-11-14_111246.png
    image_2021-11-14_111246.png
    20.4 KB · Views: 7
  • Print تست(1)_001.png
    Print تست(1)_001.png
    13.9 KB · Views: 7
Upvote 0
First Clear format of grayed cell at Print Sheet.
How about:
VBA Code: 
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, NF As String
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 - 0) / 32) + 1
For i = 1 To N
If SrRange.Rows.Count > i * 32 Then
DSheet.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
DSheet.Range("B" & Fr + (i - 1) * 32 & ":B" & Fr + (i - 1) * 32 + SrRange.Rows.Count - (i - 1) * 32 - 1).Copy
Sheets(j + 1).Range("A" & (i - 1) * 34 + 8 & ":A" & (i - 1) * 34 + 8 + SrRange.Rows.Count - (i - 1) * 32 - 1).PasteSpecial Paste:=xlPasteFormats
Sheets(j + 1).Range("A" & (i - 1) * 34 + 8 & ":A" & (i - 1) * 34 + 8 + SrRange.Rows.Count - (i - 1) * 32 - 1).Font.Size = 11
End If
Next i
With Sheets(j + 1)
 DSheet.Range("B" & Fr).Copy
.Range("C4").PasteSpecial Paste:=xlPasteFormats
 DSheet.Range("B" & Lr).Copy
.Range("G4").PasteSpecial Paste:=xlPasteFormats
.Range("C4:G4").Interior.Color = .Range("D4").Interior.Color
.Range("C4:G4").Font.Size = .Range("D4").Font.Size
.Range("C4:G4").Font.Name = .Range("D4").Font.Name
.PageSetup.PrintArea = .Range("A1:H" & N * 34 + 6).Address

End With
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
 
Upvote 0
maabadi said:
First Clear format of grayed cell at Print Sheet.
How about:
VBA Code: 
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, NF As String
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 - 0) / 32) + 1
For i = 1 To N
If SrRange.Rows.Count > i * 32 Then
DSheet.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
DSheet.Range("B" & Fr + (i - 1) * 32 & ":B" & Fr + (i - 1) * 32 + SrRange.Rows.Count - (i - 1) * 32 - 1).Copy
Sheets(j + 1).Range("A" & (i - 1) * 34 + 8 & ":A" & (i - 1) * 34 + 8 + SrRange.Rows.Count - (i - 1) * 32 - 1).PasteSpecial Paste:=xlPasteFormats
Sheets(j + 1).Range("A" & (i - 1) * 34 + 8 & ":A" & (i - 1) * 34 + 8 + SrRange.Rows.Count - (i - 1) * 32 - 1).Font.Size = 11
End If
Next i
With Sheets(j + 1)
 DSheet.Range("B" & Fr).Copy
.Range("C4").PasteSpecial Paste:=xlPasteFormats
 DSheet.Range("B" & Lr).Copy
.Range("G4").PasteSpecial Paste:=xlPasteFormats
.Range("C4:G4").Interior.Color = .Range("D4").Interior.Color
.Range("C4:G4").Font.Size = .Range("D4").Font.Size
.Range("C4:G4").Font.Name = .Range("D4").Font.Name
.PageSetup.PrintArea = .Range("A1:H" & N * 34 + 6).Address

End With
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
Click to expand...
Solved! very many thanks
 
Upvote 0
maabadi said:
.
Click to expand...
Hi again mabaadi
i have problem with print from Paper sheet
1. i can't print from Paper, this shows erroring and not print function works
2. i want reverse pasted data (D & F columns data from Paper pasted in E & G columns in Sheet and E & G columns data from Paper pasted in D & F columns in Sheet and then print
file: BookT=T.rar
 
Upvote 0
You must log in or register to reply here.

Similar threads

Z
  • Question Question
Vba - create new sheet and copy date into it.
Replies
1
Views
69
zerofeng
Z
J
  • Question Question
Macro to assign to print button with specific criteria
2
Replies
11
Views
663
Micron
M
J
  • Question Question
Using Sheets().Select in a Worksheet_Activate() macro
2
Replies
10
Views
448
jdun
J
N
  • Question Question
VBA to add title from formula to a save as name
Replies
0
Views
100
NKUNZI
N
F
  • Solved
Copy paste from one Excel workbook to another with same sheet names and update dates in range
Replies
8
Views
514
Skiier89
S

Forum statistics

Threads
1,223,943
Messages
6,175,552
Members
452,652
Latest member
eduedu

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top