Using the Range Current Region

[Unicode]

Would you know how I can remove the range " Range("A9:A20" & lastrowcount).Copy " and have the code continue reading down the rows without copying the next block of data, specially if [FONT=&quot]Ranges will change over time. First block of data could reach 200 rows going down. Second block normally provides duplicates from the first block, however, this is where column "I & J" have the other additional row data that will copy over into NewFormat2 Sheet. [/FONT][FONT=&quot]




[CODE:]




[/FONT]Sub CopyPasteSheet6()




'## The following line of code sets data value and content from Sheet "SHEET1" to (SHEET2)
ActiveWindow.SmallScroll Down:=9


Dim lastRow As Long
Dim SHEET2 As Worksheet
Dim Results As Worksheet
Dim LookupLastrow As Long




Application.ScreenUpdating = False 'Makes the code run faster and reduces screen _
flicker a bit.


'## this code line will set values from sheet ("SHEET1") into ("SHEET2") starting 5 rows down.

Set Results = Sheets("SHEET2")
lastRow = ThisWorkbook.Sheets("SHEET2").Cells(Rows.Count, 1).End(xlUp).row




Range("A9:A20" & lastrowcount).Copy
Results.Range("A" & lastRowPASTE + 5).PasteSpecial xlPasteValuesAndNumberFormats


Range("D9:D20" & lastrowcount).Copy
Results.Range("B" & lastRow + 5).PasteSpecial xlPasteValuesAndNumberFormats

Range("E9:E20" & lastrowcount).Copy
Results.Range("C" & lastRow + 5).PasteSpecial xlPasteValuesAndNumberFormats

Range("F9:F20" & lastrowcount).Copy
Results.Range("D" & lastRow + 5).PasteSpecial xlPasteValuesAndNumberFormats

Range("G9:G20" & lastrowcount).Copy
Results.Range("E" & lastRow + 5).PasteSpecial xlPasteValuesAndNumberFormats


Range("I9:I20" & lastrowcount).Copy
Results.Range("F" & lastRow + 5).PasteSpecial xlPasteValuesAndNumberFormats

Range("I25:I20" & lastRow).Copy
Results.Range("J" & lastRow + 6).PasteSpecial xlPasteValuesAndNumberFormats

Range("J25:J20" & lastRow).Copy
Results.Range("K" & lastRow + 6).PasteSpecial xlPasteValuesAndNumberFormats

Range("N10:N20" & lastrowcount).Copy
Results.Range("I" & lastRow + 6).PasteSpecial xlPasteValuesAndNumberFormats





Application.DataEntryMode = False




' Code line will merge 2 uneven columns together into one column


Set Results = Sheets("SHEET2")
lastRow = Results.Cells(Results.Rows.Count, "Z").End(xlUp).row




' this code must have double comma before True ---> (.pasteSpecial xlPasteValues, ,)
Range("J10:J20" & lastrowcount).Copy
Results.Range("G" & lastRow + 5).PasteSpecial xlPasteValuesAndNumberFormats, , True
Range("K10:K20" & lastrowcount).Copy
Results.Range("G" & lastRow + 6).PasteSpecial xlPasteValuesAndNumberFormats, , True


Range("L10:L20" & lastrowcount).Copy
Results.Range("H" & lastRow + 5).PasteSpecial xlPasteValuesAndNumberFormats, , True
Range("M10:M20" & lastrowcount).Copy
Results.Range("H" & lastRow + 6).PasteSpecial xlPasteValuesAndNumberFormats, , True
Range("N7").Select




Application.GoTo ActiveSheet.Range("A1"), True
Application.CutCopyMode = False




End Sub
[FONT=&quot]


[/FONT]