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
The file is deleted. But I try new code.
Please upload example file again.
 
Upvote 0

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
This one I think Solve your problem except print Section Until I see your uploaded file:
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 = ActiveSheet
j = ActiveSheet.Index
Sheets(j + 1).Visible = True
Sheets(j + 1).Select
Debug.Print ws.Range("A1").Value
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
maabadi said:
This one I think Solve your problem except print Section Until I see your uploaded file:
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 = ActiveSheet
j = ActiveSheet.Index
Sheets(j + 1).Visible = True
Sheets(j + 1).Select
Debug.Print ws.Range("A1").Value
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...
you did not receive the file i send?
i upload it in rar again

Book1.rar

drive.google.com drive.google.com
 
Upvote 0
I don't have access to it. You should do access to me to open that file.
 
Upvote 0
I didn't see The first sheet that I copy Data from that and Paste at Sheet Worksheet & Then Print the Print Worksheet.
I suppose the Print sheet is Visible by Default.
But Try One of these:
1.
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

Or
2.
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
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 = ActiveSheet
j = ActiveSheet.Index
y = ws.Count
For n = j + 1 To y
If ws.Name = "Print" Then
For i = 1 To 30840
If ws.Cells(34 * i + 8, 1).Value <> "" Then
n = i + 1
Else
GoTo Printing
End If
Next i
End If
Next n
Printing:
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:="Print" & (j + 1) / 2 _
    , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
    :=False, OpenAfterPublish:=True

ShP.Range("A1").ClearContents
Range(ShP.Cells(3, 2), ShP.Cells(L, 2 + LC - FC)).ClearContents
Application.ScreenUpdating = True
End Sub
 
Upvote 0
maabadi said:
I didn't see The first sheet that I copy Data from that and Paste at Sheet Worksheet & Then Print the Print Worksheet.
I suppose the Print sheet is Visible by Default.
But Try One of these:
1.
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

Or
2.
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
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 = ActiveSheet
j = ActiveSheet.Index
y = ws.Count
For n = j + 1 To y
If ws.Name = "Print" Then
For i = 1 To 30840
If ws.Cells(34 * i + 8, 1).Value <> "" Then
n = i + 1
Else
GoTo Printing
End If
Next i
End If
Next n
Printing:
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:="Print" & (j + 1) / 2 _
    , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
    :=False, OpenAfterPublish:=True

ShP.Range("A1").ClearContents
Range(ShP.Cells(3, 2), ShP.Cells(L, 2 + LC - FC)).ClearContents
Application.ScreenUpdating = True
End Sub
Click to expand...
first sheet and other sheet have specific data are a duplicate of Sheet
for 2 that is have compile error line y=ws.Count
for 1 print is ok that is print from Print, but that is show nothing, i think it means clear contents before print function, anyway first print all data and after that clear contents?
and anyway solve error of merged cells?
THANK YOU FOR HARD WORKING :)
 
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,947
Messages
6,175,562
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