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:
For #N/A at Headers Column F you should check all of your data at Column A is Numbers Not Text.
For Correct Printing Pages Try this:
VBA Code: 
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 Lr
If Cells(i, FC).Interior.Color = 4697456 And Cells(i, FC).Value <> "" Then
ShP.Range("A1").Value = Cells(i, FC).Value
k = i + 2
GoTo Resum
End If
Next i
Resum:
For i = Fr To Lr
If Cells(i, FC + 1).Value <> "" Then
Range(ShP.Cells(3 + i - k, 2), ShP.Cells(3 + i - k, 2 + 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" & j / 2 _
  , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
   :=False, OpenAfterPublish:=True
Sheets(j + 1).Visible = False
Sheets(j).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, 2), ShP.Cells(L, 1 + LC - FC)).ClearContents
Application.ScreenUpdating = True
End Sub
Click to expand...
yes, you are right, column A fill with text, if problem with copy this column to Sheet solved, it can be, because column A in Sheet not linked to Print and even select at column A is easier than select at column B
and after that code i said fix merged cell error, order not correct and copy/paste not doing correctly
 
Upvote 0

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Everything with this code is ok, except copy correct some green cell and copy data from column G and fix delay after print
VBA Code: 
Sub CopyPaste()
Dim ShP As Worksheet, SrRange As Range, i As Long, k As Long, L As Long, CL As Range
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 = Y To Fr - 1
If Y < 0 Then
i = 1
Y = 1
End If
If Cells(i, 1).Interior.Color = 4697456 And Cells(i, 1).Value <> "" Then
ShP.Range("A1").Value = Cells(i, 1).Value
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
ShP.Range("A1").Value = Cells(i, FC).Value
k = i + 2
ElseIf Cells(i, FC).Value <> "" Then
Range(ShP.Cells(3 + i - Fr, 2), ShP.Cells(3 + i - Fr, 2 + LC - FC)).Value = Range(Cells(i, FC), 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
For i = 1 To 30840
If Cells(34 * i + 8, 1).Value <> "" Then
n = i + 1
Else
GoTo Printing
End If
Next i
Printing: ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="Print" & j / 2 _
  , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
   :=False, OpenAfterPublish:=True
Sheets(j + 1).Visible = False
Sheets(j).Select
ShP.Range("A1:A2").ClearContents
'Range(ShP.Cells(3, 2), ShP.Cells(L, 2 + LC - FC)).ClearContents
On Error Resume Next
For Each CL In Range(ShP.Cells(3, 2), ShP.Cells(L, 2 + LC - FC))
        If CL.MergeCells Then
        CL.MergeArea.ClearContents
        Else
        CL.ClearContents
        End If
    Next CL
Application.ScreenUpdating = True
End Sub
 
Upvote 0
i think green cell is ok ,some customer have problem (for example name of customer 1 use for customer 2), the delay after print not allowed me test all customer quickly that i say no problem with this
but not copy from column G
 
Upvote 0
Unexpc said:
Everything with this code is ok, except copy correct some green cell and copy data from column G and fix delay after print
Click to expand...

Unexpc said:
but not copy from column G
Click to expand...
1. I Don't Understand what is problem with Column G, I test it on your file & its works OK.
2. Are you have more than one Green Cell at Selected Range?
3. If Yes, which Green Cell You want to See at Cell A1
4. For Delaying After Print, I told it because we add loops to find merged cell & Clear Contents.
5. what is Problem with my last code sending at Post #60

AND Please Some Example Screenshot From Exactly What you have at Data sheet & What Exactly you want to see at Sheet & Print Worksheet
 
Upvote 0
maabadi said:
1. I Don't Understand what is problem with Column G, I test it on your file & its works OK.
2. Are you have more than one Green Cell at Selected Range?
3. If Yes, which Green Cell You want to See at Cell A1
4. For Delaying After Print, I told it because we add loops to find merged cell & Clear Contents.
5. what is Problem with my last code sending at Post #60

AND Please Some Example Screenshot From Exactly What you have at Data sheet & What Exactly you want to see at Sheet & Print Worksheet
Click to expand...
1. does'nt copy from column G and in print that column linked empty
2.Yes, every customer name in green cell
3.i want when select first cell of my range, give first green cell before that
4.if anyway solve this A1&A2 merged, if not i unmerge that two cells
5.order of copy/pase not correct and everything not in correct order of cells in print
 

Attachments

  • Screenshot 2021-03-14 161631.png
    Screenshot 2021-03-14 161631.png
    47.1 KB · Views: 3
  • Print2.5_Page1.jpg
    Print2.5_Page1.jpg
    196.9 KB · Views: 3
Upvote 0
2. Are 2nd & Other Green Cells Comes after Last Values of first Customer. E.G. 2nd Customer After Text14 at your screenshot.
5. What means don't have correct order copy paste give me example. Problem for rows or Columns.
 
Upvote 0
maabadi said:
2. Are 2nd & Other Green Cells Comes after Last Values of first Customer. E.G. 2nd Customer After Text14 at your screenshot.
5. What means don't have correct order copy paste give me example. Problem for rows or Columns.
Click to expand...
2.Yes, but about Text14, all of customer range changeable,
5.i check it again,sorry this is my wrong, i should select at Column A after i want you doing it on code,all things correct, this is solved but green cell still have problem
 
Upvote 0
This one Add Customer Names to Column A at Sheet Worksheet Bu you can't See that at Print Sheet Because you don't have column A from Sheet worksheet at Print Sheet.
It has 3 empty lines between each Customer Selected at Print Sheet.
VBA Code: 
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" & j / 2 _
  , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
   :=False, OpenAfterPublish:=True
Sheets(j + 1).Visible = False
Sheets(j).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
 
Upvote 0
maabadi said:
This one Add Customer Names to Column A at Sheet Worksheet Bu you can't See that at Print Sheet Because you don't have column A from Sheet worksheet at Print Sheet.
It has 3 empty lines between each Customer Selected at Print Sheet.
VBA Code: 
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" & j / 2 _
  , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
   :=False, OpenAfterPublish:=True
Sheets(j + 1).Visible = False
Sheets(j).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
Click to expand...
Yes,you solved this, and last things
1.Please change file name to Print Customer name (that merged cell give by green cell) that cause not erroring after print of two or more customer because have same name (for me Print 2.5)
2.screen update or not going to Sheet after printing and attend in sheet that copied data
3.print just pages that have data and not printing empty pages
THANK YOU
 
Upvote 0
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.
VBA Code: 
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question
Calculations require application restart
Replies
2
Views
167
cpupartsplz
C
F
  • Question
Copy to Multiple Worksheets With Different Arranged Headers ROW by ROW
Replies
1
Views
69
Cubist
Cubist
S
  • Solved
Copy/Paste cell if checkbox selected
Replies
4
Views
340
kevin9999
K
L
  • Question
VBA ERROR: Cannot Paste the Selected Copied Content
Replies
7
Views
210
Joe4
Joe4
N
  • Question
Macro to Clearing Contents of Row affect Validation Lists
Replies
0
Views
219
Nathan Asius
N

Forum statistics

Threads
1,215,247
Messages
6,123,847
Members
449,129
Latest member
krishnamadison

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