Excel 初始宏运行后，将源范围移动到下一行并复制

最近，社区的一位成员帮助我解决了如何为我的项目构建宏的问题。以下宏的工作方式与我所希望的完全相同。然而，有一个手动依赖，我正试图纠正

源范围预定义为特定单元格引用（例如A10、B10、C10、F10…），运行此宏后，我希望源范围向下移动到下一行，以便下次调用宏时，它复制A11、B11、C11、F11

如果可能的话，请告诉我。以下是我一直使用的VBA代码：

Public Sub Update_Project_1()

    ' Set a reference to the source sheet
    Dim sourceSheet As Worksheet
    Set sourceSheet = ThisWorkbook.Worksheets("High Level Tracker")
    
    ' Set a reference to the target sheet
    Dim targetSheet As Worksheet
    Set targetSheet = ThisWorkbook.Worksheets("Project 1 Detailed Tracker")

    ' Set a reference to the source range
    Dim sourceRange As Range
    Set sourceRange = sourceSheet.Range("A10,B10,C10,F10,H10")

    ' Get last row in target sheet
    Dim lastRow As Long
    lastRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row

    ' Loop through each cell in source range
    Dim sourceCell As Range
    For Each sourceCell In sourceRange.Cells
        ' Output values from source range into next empty row in target
        Dim columnCounter As Long
        targetSheet.Range("A" & lastRow + 1).Offset(, columnCounter).Value = sourceCell.Value
        columnCounter = columnCounter + 1
    Next sourceCell

End Sub

---

任何帮助都将不胜感激，谢谢

当前单元格称为

ActiveCell

。要转到另一个单元格，可以使用

Offset（）

函数

因此，这两种方法的结合给出了以下一行源代码：

ActiveCell.Offset(1,0).Activate

---

这意味着：取当前活动单元格，再行一行，但没有列（1,0），然后激活该单元格。

不是最干净的单元格，但可能会有所帮助

在代码的开头，只需添加：

Dim ThisRow As Long
ThisRow = InputBox("What row?", , 10)

这将在每次执行宏时询问用户一个行号（默认值=10）

然后更换线路

Set sourceRange=sourceSheet.Range（“A10、B10、C10、F10、H10”）

与

Set sourceRange=sourceSheet.Range（“A”&ThisRow&“、B”&ThisRow&“、C”&ThisRow&“、F”&ThisRow&“、H”&ThisRow）

---

这样，每次执行都将允许您选择目标行的内容，而无需手动编辑代码。

您可以在源工作表中找到最后一个空行，然后将值复制到目标工作表中

Public Sub Update_Project_1()

    ' Set a reference to the source sheet
    Dim sourceSheet As Worksheet
    Set sourceSheet = ThisWorkbook.Worksheets("High Level Tracker")
    
    ' Set a reference to the target sheet
    Dim targetSheet As Worksheet
    Set targetSheet = ThisWorkbook.Worksheets("Project 1 Detailed Tracker")
    
    ' Get last row in source sheet
    Dim lastRowSource As Long
    lastRowSource = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
    
    ' Define the source range address
    Dim sourceRangeAddress As String
    sourceRangeAddress = "A<r>,B<r>,C<r>,F<r>,H<r>"
    
    ' Replace next row in source rane
    sourceRangeAddress = Replace(sourceRangeAddress, "<r>", lastRowSource)
    
    ' Set a reference to the source range
    Dim sourceRange As Range
    Set sourceRange = sourceSheet.Range(sourceRangeAddress)
    
    ' Get last row in target sheet
    Dim lastRowTarget As Long
    lastRowTarget = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row

    ' Loop through each cell in source range
    Dim sourceCell As Range
    For Each sourceCell In sourceRange.Cells
        ' Output values from source range into next empty row in target
        Dim columnCounter As Long
        targetSheet.Range("A" & lastRowTarget + 1).Offset(, columnCounter).Value = sourceCell.Value
        columnCounter = columnCounter + 1
    Next sourceCell

End Sub

公共子更新_项目_1（）
'设置对源工作表的引用
将源表设置为工作表
Set sourceSheet=ThisWorkbook.Worksheets（“高级跟踪器”）
'设置对目标工作表的引用
将目标工作表变暗为工作表
Set targetSheet=ThisWorkbook.Worksheets（“项目1详细跟踪程序”）
'获取源工作表中的最后一行
将lastRowSource设置为长
lastRowSource=sourceSheet.Cells（sourceSheet.Rows.Count，“A”）.End（xlUp）.Row
'定义源范围地址
Dim sourceRangeAddress作为字符串
sourceRangeAddress=“A、B、C、F、H”
'替换源rane中的下一行
sourceRangeAddress=Replace（sourceRangeAddress，“，lastRowSource）
'设置对源范围的引用
将源范围变暗为范围
Set sourceRange=sourceSheet.Range（sourceRangeAddress）
'获取目标工作表中的最后一行
将最后一行目标变暗为长
lastRowTarget=targetSheet.Cells（targetSheet.Rows.Count，“A”）.End（xlUp）.Row
'循环通过源范围中的每个单元格
暗淡源单元格作为范围
对于sourceRange.Cells中的每个sourceCell
'将值从源范围输出到目标中的下一个空行
暗柱计数器与长柱计数器相同
targetSheet.Range（“A”&lastRowTarget+1）.偏移量（，列计数器）.Value=sourceCell.Value
columnCounter=columnCounter+1
下一个源单元
端接头

谢谢！这有助于我正在构建的跟踪器的性质，因为接受用户输入可以实现更大的灵活性谢谢Ricardo！不幸的是，由于跟踪器是如何设置的，在源工作表中查找最后一个空行只会更新跟踪器中的最后一个项目。将仔细查看此代码，并尝试完成它。再次感谢！