时间戳

首页 > 解决方案 > 初始宏运行后，将源范围移动到下一行并复制

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

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

标签： excelvba

解决方案

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

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

推荐阅读