从 Range 复制值并将每个具有不同给定（行）偏移量的值粘贴到另一个 sheet

Question

首先我想自我介绍一下。 Iam Miguel 和我最近开始学习 VBA 以改进和节省工作时间。我熟悉所有类型的公式，但在转向 VBA 时，我有时会卡住。

我正在尝试从 Sheet"Aux" 循环范围 A2:A355 并将每个值复制到 sheet "CS"，然后粘贴每个值在列 A:A 中，但偏移量在范围 B2:B355 Sheet "Aux" 中给出。例如，我给出了所附的例子。 示例代码：

这是代码：

Sub cablexsection() 
Dim s As Integer
Dim smax As Integer
smax = Sheets("Aux").Range("b1").Value

Sheets("CS").Activate

For s = 3 To smax
Sheets("CS").Cells(s, 1).Value = Sheets("Aux").Cells(s, 1).Value

'here I have to set the offset to down in order to paste cells given Sheets("Aux").Cells(s, 2) values

Next s

End Sub

在 link 下您可以找到要处理的文件：

Original File

非常感谢您，如果您重复这个问题，我们深表歉意。我试图浏览论坛，但也许我不知道该写什么。

Answer 1

试试这个

Option Explicit

Sub CableXsection()
    Dim wsAux As Worksheet, wsCS As Worksheet
    Dim s As Long, sMax As Long, offSetCell As Range

    Set wsAux = ThisWorkbook.Worksheets("Aux")
    Set wsCS = ThisWorkbook.Worksheets("CS")

    sMax = wsAux.Range("B1").Value

    Application.ScreenUpdating = False

    For s = 3 To sMax

        Set offSetCell = wsAux.Cells(s, 2)    '2 is the offset column from the same row

        If Not IsError(offSetCell) And IsNumeric(offSetCell) Then
            wsCS.Cells(offSetCell.Value2 + s, 1).Value = wsAux.Cells(s, 1).Value
        End If
    Next

    Application.ScreenUpdating = True
End Sub

从 Range 复制值并将每个具有不同给定（行）偏移量的值粘贴到另一个 sheet

Copy values from Range and paste each one with different given (row) offset in another sheet

vba

for-loop

range

offset