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

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
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

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,948
Messages
6,175,566
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