Copy selection range and paste in a specific sheet

[Unexpc]

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...

 

[maabadi]

Paste in a sheet that named Sheet from cell A3

I think I understand Wrong. what is your sheet name that want paste to it? Cell A3 Value of Active sheet. If it is correct try this:

Sub CopyPaste()
Dim ShP As Worksheet, SrRange As Range, Cell As Range, i As Long
Set ShP = Worksheets(Range("A3").Value)
Set SrRange = Selection
Debug.Print SrRange.Address
For Each Cell In SrRange
If Cell.Interior.Color = 4697456 And Cell.Value <> "" Then
ShP.Range("G2").Value = Cell.Value
ElseIf Cell.Value <> "" Then
ShP.Range("A" & 3 + i).Value = Cell.Value
i = i + 1
End If
Next Cell
'SrRange.ClearContents
End Sub

 

[Unexpc]

I think I understand Wrong. what is your sheet name that want paste to it? Cell A3 Value of Active sheet. If it is correct try this:

Sub CopyPaste()
Dim ShP As Worksheet, SrRange As Range, Cell As Range, i As Long
Set ShP = Worksheets(Range("A3").Value)
Set SrRange = Selection
Debug.Print SrRange.Address
For Each Cell In SrRange
If Cell.Interior.Color = 4697456 And Cell.Value <> "" Then
ShP.Range("G2").Value = Cell.Value
ElseIf Cell.Value <> "" Then
ShP.Range("A" & 3 + i).Value = Cell.Value
i = i + 1
End If
Next Cell
'SrRange.ClearContents
End Sub

i want paste A3 in sheet that name Print in cell E2

 

[Unexpc]

i want not just A3, all of cell that have that green color i select, paste that specific cell in sheet named Print

 

[maabadi]

This one Paste Green Color Cell To G2 & Others to A3 and Down. if you want to Paste to Other cells Change it to what you want.

Sub CopyPaste()
Dim ShP As Worksheet, SrRange As Range, Cell As Range, i As Long
Set ShP = Worksheets("Print")
Set SrRange = Selection
Debug.Print SrRange.Address
For Each Cell In SrRange
If Cell.Interior.Color = 4697456 And Cell.Value <> "" Then
ShP.Range("G2").Value = Cell.Value
ElseIf Cell.Value <> "" Then
ShP.Range("A" & 3 + i).Value = Cell.Value
i = i + 1
End If
Next Cell
'SrRange.ClearContents
End Sub

For Print Use the code I give to you before ( and add it after line of Next Cell) and after that Remove ' from first of ClearContents Line.

 

[Unexpc]

This one Paste Green Color Cell To G2 & Others to A3 and Down. if you want to Paste to Other cells Change it to what you want.

Sub CopyPaste()
Dim ShP As Worksheet, SrRange As Range, Cell As Range, i As Long
Set ShP = Worksheets("Print")
Set SrRange = Selection
Debug.Print SrRange.Address
For Each Cell In SrRange
If Cell.Interior.Color = 4697456 And Cell.Value <> "" Then
ShP.Range("G2").Value = Cell.Value
ElseIf Cell.Value <> "" Then
ShP.Range("A" & 3 + i).Value = Cell.Value
i = i + 1
End If
Next Cell
'SrRange.ClearContents
End Sub

For Print Use the code I give to you before ( and add it after line of Next Cell) and after that Remove ' from first of ClearContents Line.

yes i know, but in this step something wrong the copy green color cell is ok and does work, but other cell does not work, actually i edit range and see what am i wrong, this show compile error...

Sub CopyPaste()
Dim ShP As Worksheet, SrRange As Range, Cell As Range, i As Long
Set ShP = Worksheets("Sheet")
Set SrRange = Selection
Debug.Print SrRange.Address
For Each Cell In SrRange
If Cell.Interior.Color = 4697456 And Cell.Value <> "" Then
ShP.Range("A1").Value = Cell.Value
ElseIf Cell.Value <> "" Then
ShP.Range("B" & 3 + i).Value = Cell.Value
i = i + 1
End If
Next Cell
Dim MyRange As Range
Dim ws As Worksheet
Dim Lastrow As Long
Dim i As Long
Dim n As Long
Dim j As Long
Dim PrintArea As String
Application.ScreenUpdating = False
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
Application.ScreenUpdating = True
End Sub
SrRange.ClearContents
End Sub

 

[Unexpc]

i delete End Sub after Application.ScreenUpdating = True this insert wrong in this code i send

 

[Unexpc]

and i don't know i correct understand or not, but for clear contents i want clear contents that pasted data in sheet that name Sheet not clear contents data that copied

 

[maabadi]

When Code show Compile error, which line highlighted?
For ClearContents Pasted Data After Print Change First Part & Second Part to this:

Sub CopyPaste()
Dim ShP As Worksheet, SrRange As Range, Cell As Range, i As Long, L as Long
Set ShP = Worksheets("Sheet")
Set SrRange = Selection
For Each Cell In SrRange
If Cell.Interior.Color = 4697456 And Cell.Value <> "" Then
ShP.Range("A1").Value = Cell.Value
ElseIf Cell.Value <> "" Then
ShP.Range("B" & 3 + i).Value = Cell.Value
i = i + 1
End If
Next Cell
L = i

The Last Line:

ShP.Range("B3:B" & 2 + L).ClearContents

 

[Unexpc]

this line highlighted

Sub CopyPaste()
Dim ShP As Worksheet, SrRange As Range, Cell As Range, i As Long
Set ShP = Worksheets("Sheet")
Set SrRange = Selection
Debug.Print SrRange.Address
For Each Cell In SrRange
If Cell.Interior.Color = 4697456 And Cell.Value <> "" Then
ShP.Range("A1").Value = Cell.Value
ElseIf Cell.Value <> "" Then
ShP.Range("B" & 3 + i).Value = Cell.Value
i = i + 1
End If
Next Cell
Dim MyRange As Range
Dim ws As Worksheet
Dim Lastrow As Long
Dim i As Long
Dim n As Long
Dim j As Long
Dim PrintArea As String
Application.ScreenUpdating = False
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
Application.ScreenUpdating = True
End Sub
SrRange.ClearContents
End Sub

and when i use last code you send, still just copy green cell and pasted not anymore, even that green cell after copy and paste not clear contents...

 

[maabadi]

I don't see what line Highlighted (Take Yellow Background when show error). only upload that Line Not Complete Code
you don't modify my last recommendations to your code also.
Why you have two End Sub at your code. Thus the codes after First End Sub not run.
Also Add this line for ClearContents of Green cell Pasted Before Last line:

ShP.Range("A1").ClearContents