增加范围

Question

我在A到U列中有135行数据 我正在尝试编写一个脚本，该脚本将帮助我将数据的每一列一个一个地复制到一个干净的工作表中。 现在，我写了一些将在前两列中执行的代码，我希望它能更自动/动态地执行，而不是复制粘贴这两个代码块并更改范围

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

假设工作表“ 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

Answer 3

您可以将数据的每一列读入一个数组，然后将其粘贴到新列中。这样，您可以执行数据所需的任何突变。 如果您有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