Увеличение диапазона

Question

у меня есть 135 строк данных в столбцах от А до U Я пытаюсь написать скрипт, который поможет мне копировать каждый столбец данных один под другим на чистый лист. Прямо сейчас я написал некоторый код, который будет делать это для первых двух столбцов, и я бы предпочел, чтобы это делалось более автоматически / динамически, вместо того, чтобы копировать, вставляя эти два блока кода и изменяя диапазоны

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

Попробуй это. При необходимости измените имя листа.

Вы можете ускорить операцию, напрямую передавая значения, а не копируя и вставляя.

Вы можете определить 134 как константу, поэтому вам нужно всего лишь один раз изменить код, а не три.

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

Вы можете прочитать каждый столбец данных в массив, а затем вставить его в новый столбец.Таким образом, вы можете выполнять любые мутации, необходимые для данных.Если у вас 135 строк (всегда)

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

Answer 3

Предположим, ваши данные в листе «Rom» начинаются со строки 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