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

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
One Thing I realized.
1. Are you want Paste Data to Sheet Worksheet & then Print Print worksheet, Why? OR
2. You want Paste Data at Print sheet & then Print it.
3. Are your Print Sheet is Hide or Visible?

I think you had related formula between Sheet & Print Worksheet & when paste data at sheet worksheet then you have the same data at related Cell at Print Sheet,
if not then we should change Target worksheet name.
 
Upvote 0
1.Yes, because sheet that named Print, print formed of Sheet
2.No
3.i want hide and visible too

Yes, a specific formula you solved for link data between Sheet and Print and may cause have another solution for another your solved my another post :)
 
Upvote 0
I think your formula at Print sheet take missaddress od Cells from Sheet Worksheet. Please Check it.
This macro do all thing and print but don't hide print sheet & Clear Contents. Please test it and check Are you see result
1. At Sheet Worksheet.
2. At Print Sheet.
3. AND What is your exact name of print sheet: Print1 , Print2 or ....
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
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
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 - k, 2), ShP.Cells(3 + i - k, 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 + 1) / 2 _
  , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
   :=False, OpenAfterPublish:=True
'Sheets(j + 1).Visible = True
'Sheets(j).Select
'ShP.Range("A1").ClearContents
'Range(ShP.Cells(3, 2), ShP.Cells(L, 2 + LC - FC)).ClearContents Application.ScreenUpdating = True
End Sub
 
Upvote 0
This is workbook with code, please check it and see Sheet code, that have a specific code when specific cells fill, in Print copy a page and paste next page

Book1.rar

drive.google.com drive.google.com
 
Upvote 0
j
maabadi said:
I think your formula at Print sheet take missaddress od Cells from Sheet Worksheet. Please Check it.
This macro do all thing and print but don't hide print sheet & Clear Contents. Please test it and check Are you see result
1. At Sheet Worksheet.
2. At Print Sheet.
3. AND What is your exact name of print sheet: Print1 , Print2 or ....
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
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
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 - k, 2), ShP.Cells(3 + i - k, 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 + 1) / 2 _
  , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
   :=False, OpenAfterPublish:=True
'Sheets(j + 1).Visible = True
'Sheets(j).Select
'ShP.Range("A1").ClearContents
'Range(ShP.Cells(3, 2), ShP.Cells(L, 2 + LC - FC)).ClearContents Application.ScreenUpdating = True
End Sub
Click to expand...
just copy/paste Green Cell and other data not doing this function
 
Upvote 0
One thing.
You don't tell you want to copy green Cell from column A.
Because of that you see merged cell clear contents error.
This is Modified Version Please Test it , Also I upload your file with macro for you
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 = 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 - k, 2), ShP.Cells(3 + i - k, 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
Application.ScreenUpdating = True
End Sub
Book1.xlsm
 
Upvote 0
maabadi said:
One thing.
You don't tell you want to copy green Cell from column A.
Because of that you see merged cell clear contents error.
This is Modified Version Please Test it , Also I upload your file with macro for you
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 = 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 - k, 2), ShP.Cells(3 + i - k, 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
Application.ScreenUpdating = True
End Sub
Book1.xlsm
Click to expand...
yes, sorry this is my wrong but still show this error (merged cell) why this happened?(the format of my worksheet that is i send you and no difference...)(highlight this line: Range(ShP.Cells(3, 2), ShP.Cells(L, 2 + LC - FC)).ClearContents) and another thing, in the file you uploaded i test with your range and doing correctly without error, but i tested again with another range, cells show nothing and just copy/paste green cell and why you started at B5?
 
Last edited:
Upvote 0
Are you have merged Cell at selection Range. this is cause of it.
I start at B5 to show you if you have empty cell at first Cell of Each Selected rows, this macro don't copy that row and paste another rows without space at destination cells.
Also Try this Macro for solving Merged Cell Errors.
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
maabadi said:
Are you have merged Cell at selection Range. this is cause of it.
I start at B5 to show you if you have empty cell at first Cell of Each Selected rows, this macro don't copy that row and paste another rows without space at destination cells.
Also Try this Macro for solving Merged Cell Errors.
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
Click to expand...
fix erroring merged cells :) and data doing correctly copy/paste but how can i select together green cell and data? when select this two at the same time just copy/paste green cell and data not doing this function, and when i select just data, not copy/paste correct cell customer name
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question
Calculations require application restart
Replies
2
Views
240
cpupartsplz
C
A
  • Solved
Select Sheet Paste on last
Replies
5
Views
87
Joe4
Joe4
F
  • Question
Copy to Multiple Worksheets With Different Arranged Headers ROW by ROW
Replies
1
Views
126
Cubist
Cubist
S
  • Solved
Copy/Paste cell if checkbox selected
Replies
4
Views
503
kevin9999
K
K
  • Question
vba code for unlocking cell after paste
Replies
1
Views
89
MikeVol
MikeVol

Forum statistics

Threads
1,216,228
Messages
6,129,613
Members
449,520
Latest member
TBFrieds

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