Make Looping Macro to copy same range but Paste Special at end of existing data

jhere01

New Member
Joined
Jul 21, 2011
Messages
14
Hello All!
So here's my frustration... I am in no way an expert to excel but have gained much from this forum.
I have a spreadsheet that I'm trying to get data from a sheet "V All", it gets its data based on a formula using vlookup from sheet "jhere01". I want to Paste Special from "V All" to "CLEAN ALL" at the first blank cell in column A, replace any cells with " " and "#N/A" then sort A to Z that section. after the sort copy Cells A1 and A2 and paste at the first blank cells. A1 and A2 are "*********" just intended to be a start and end reference of what was just pasted and sorted. After that it deletes some contents in sheet "jhere01" based on a color filter, then does the process again but to column B.
So I need it to keep alternating pasting/sorting/adding "*******" at the first blank Cell between column A and B.
Hope this makes sense?
Here's what I have so far but if I run it over and over it pastes over the data I did the previous time...


Sub CleanLabels()
'
' CleanLabels Macro
'


'
Range("L11").Select
ActiveSheet.Range("$B$12:$L$686").AutoFilter Field:=11, Criteria1:=RGB(146 _
, 208, 80), Operator:=xlFilterCellColor
Range("B13:I13").Select
Range(Selection, Selection.End(xlDown)).Select
Sheets("V All").Select
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("CLEAN ALL").Select
Selection.End(xlDown).Select
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:=" ", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("CLEAN ALL").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("CLEAN ALL").Sort.SortFields.Add Key:=Range("A4"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("CLEAN ALL").Sort
.SetRange Range("A4:A9303")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1:A2").Select
Selection.Copy
Selection.End(xlDown).Select
ActiveWindow.SmallScroll Down:=12
Range("A142").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
Sheets("jhere01").Select
Selection.ClearContents
Range("L10").Select
ActiveSheet.Range("$B$12:$L$686").AutoFilter Field:=11
Range("B13:I13").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Range("B13:I2567").Select
ActiveWorkbook.Worksheets("jhere01").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("jhere01").Sort.SortFields.Add Key:=Range( _
"E13:E2567"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("jhere01").Sort.SortFields.Add Key:=Range( _
"H13:H2567"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("jhere01").Sort.SortFields.Add Key:=Range( _
"I13:I2567"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("jhere01").Sort
.SetRange Range("B13:I2567")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("L11").Select
ActiveSheet.Range("$B$12:$L$686").AutoFilter Field:=11, Criteria1:=RGB(146 _
, 208, 80), Operator:=xlFilterCellColor
Range("B13:I13").Select
Range(Selection, Selection.End(xlDown)).Select
Sheets("V All").Select
ActiveWindow.SmallScroll Down:=-6
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("CLEAN ALL").Select
Range("B1").Select
Selection.End(xlDown).Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=" ", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("CLEAN ALL").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("CLEAN ALL").Sort.SortFields.Add Key:=Range("B4"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("CLEAN ALL").Sort
.SetRange Range("B4:B9303")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("B1:B2").Select
Selection.Copy
Selection.End(xlDown).Select
Range("B118").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
Range("A1").Select
Sheets("jhere01").Select
Selection.ClearContents
Range("L11").Select
ActiveSheet.Range("$B$12:$L$686").AutoFilter Field:=11
Range("B13:I13").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Range("B13:I2567").Select
ActiveWorkbook.Worksheets("jhere01").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("jhere01").Sort.SortFields.Add Key:=Range( _
"E13:E2567"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("jhere01").Sort.SortFields.Add Key:=Range( _
"H13:H2567"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("jhere01").Sort.SortFields.Add Key:=Range( _
"I13:I2567"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("jhere01").Sort
.SetRange Range("B13:I2567")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
End Sub
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Looks like you need to be using the "LastRow" method to determine where to copy your data. If you are not familiar with that I'll provide a brief explanation.

Looking at your code I see the following lines:
Code:
[COLOR=#333333]Range("A1:A2").Select[/COLOR]
[COLOR=#333333]Selection.Copy[/COLOR]
[COLOR=#333333]Selection.End(xlDown).Select[/COLOR]
[COLOR=#333333]ActiveWindow.SmallScroll Down:=12[/COLOR]
[COLOR=#333333]Range("A142").Select[/COLOR]
[COLOR=#333333]ActiveSheet.Paste
[/COLOR]

If you are Selecting Cell "A142" because it is currently the first vacant row that obviously only works for the first time you copy/paste. More importantly it does not ensure that additional rows of data haven't already been added and thus A142 is not the first vacant row at all.

So to get around this, declare a variable as Long and then assign to that variable the first vacant row by:

Code:
Dim nextrow as long

nextrow = [/COLOR]Cells(Rows.Count, "A").End(xlUp).Row + 1
[COLOR=#333333]Range("A1:A2").Select[/COLOR]
[COLOR=#333333]Selection.Copy[/COLOR]
[COLOR=#333333]Range("A" & nextrow).Select[/COLOR]
[COLOR=#333333]ActiveSheet.Paste
[CODE]

Apply this approach anywhere you need to paste data to the next available vacant row.[/COLOR]
 
Upvote 0
THANK you frank_AL !
ok so that worked for me to to paste in the first empty cell but now I'm having trouble with the following...
so when I paste it's always the same amount of cells from sheet "V All" cells A1:A9300 and they get pasted to the first blank cell in sheet
"CLEAN ALL". BUT...
I need to do the replace and sort of the range its pasting only which will change based on where it pastes...
hope that makes sense
Help Please?!?!?!?!???

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False
Selection.Replace What:=" ", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("CLEAN ALL").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("CLEAN ALL").Sort.SortFields.Add Key:=Range("A4"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("CLEAN ALL").Sort
.SetRange Range("A4:A9303")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
 
Upvote 0
jhere,

So by determining the value of nextrow which will be the first row of pasted data we can use that value to set the range that you want to sort.

Change the .SetRange line to be:
Code:
.SetRange Range("A" & nextrow & ":A" @ nextrow + 9299)
[CODE]

The value 9299 is 9303 - 4
 
Upvote 0

Forum statistics

Threads
1,216,523
Messages
6,131,151
Members
449,626
Latest member
Stormythebandit

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