求修改增加复制区域的代码

lagos

原代码只能复制一列中指定区域行数，现在需要在原代码基础上增加多一列。详情请看附件： 求修改增加复制区域的代码.rar (16.93 KB, 下载次数: 1)

2023-5-29 23:47 上传

点击文件名下载附件

liulang0808

Option Explicit

Sub 记录()
    Dim col As Integer, i As Integer, ii As Integer
    Dim arr(2 To 23, 1 To 2) '2可改，2为第2行开始,此处的23要比下面的22大
    col = Sheets("表2").Cells(2, Columns.Count).End(xlToLeft).Column '最少为2
    With Sheets("表1")
        
        
        For i = 2 To 22
        
            arr(i, 1) = .Cells(i - 1, 3) '从第三列复制
            arr(i, 2) = .Cells(i - 1, 4) '从第三列复制
         
        Next i
    End With
   
    Sheets("表2").Cells(1, col + 2).Resize(22, 2) = arr 'Application.WorksheetFunction.Transpose(arr) 'col+2是间隔1列粘贴，resize里的2是列数，1为复制1列，2为复制2列
   
   
End Sub

liulang0808

。。。。。。。。。。。。。。