Incrementing a range

Question

I have 135 rows of data in columns A to U I am trying to write a script that will help me copy each column of data one under another to a clean worksheet. Right now i wrote some code that will do it for the first two columns and i would prefer to have it done more automatically/dynamically instead of me copy pasting these two code blocks and altering the ranges

Range("A764:A897").Select 
Selection.Copy
Sheets("New").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
SkipBlanks _
:=False, Transpose:=False

Sheets("Rom").Select
Range("B764:B897").Select 'id like to have this increment automaticaly
Selection.Copy
Sheets("New").Select
Range("A135").Select 'id like to have this increment automaticaly
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
 SkipBlanks _
    :=False, Transpose:=False

Answer 1

Try this. Adjust sheet name as necessary.

You can speed up the operation by directly transferring values rather then copying and pasting.

You could define the 134 as a constant so you only have to change once in the code rather than three times.

Sub x()

Dim rCopy As Range
Dim r As Long: r = 1

Set rCopy = Sheets("Name of source sheet").Range("A764").Resize(134) 'adjust sheet name

Do Until IsEmpty(rCopy(1))
    Sheets("New").Cells(r, 1).Resize(134).Value = rCopy.Value
    Set rCopy = rCopy.Offset(, 1)
    r = r + 134
Loop

End Sub

Answer 2

Supposing your data in sheet “Rom” start at row 764:

Sub test()

Dim ws1, ws2 as string
Dim i, lr, lc as long 

ws1 = “Rom”
ws2 = “New”

lc = sheets(ws1).cells(764,columns.count).end(xltoleft).column

For i = 1 to lc

 lr = sheets(ws2).cells(Rows.count,1).End(xlUp).row + 1

sheets(ws1).range(cells(i, 764),cells(i,897)).Select
Selection.Copy
Sheets(ws2).cells(lr,1).Select
Selection.PasteSpecial Paste:=xlPasteValues

Next

End sub

Answer 3

You can read in each column of data to an array and then paste it into your new column. In this way, you can perform any mutations needed on the data. If you have 135 rows (always)

Dim ws As Worksheet, arr As Variant, myRange As Range, i As Integer, col As Integer, k As Integer
Set ws = ThisWorkbook.Sheets("Sheet1") ' or whatever your worksheet is
ReDim arr(1 To 135*22) ' 22 letters from A To U
k = 1
With ws
   For col = 1 To 22 
      For i = 764 To 897
         arr(k) = .Cells(col, i).Value2 ' if you need to do anything else here
         k = k+1
      Next i
   Next col
End with
Set ws = ThisWorkbook.Sheets("New") 'or wherever this is going
With ws
   .Range("A1").Resize(UBound(arr), 1).Value = Application.Transpose(arr)
End with