基于列值迁移Excel指定单元格区域至其他工作表的代码修改需求

Got it, let's adjust your existing Excel VBA code to fit those two requirements perfectly. I'll break down the changes step by step and provide a complete, tested example.

1. 替换整行复制为指定区域复制 #

Your original code likely uses Rows(sourceRow).Copy to duplicate an entire row. We'll swap this out to target only the range you need (e.g., C8:J8). Instead of hardcoding the row number, we'll use a variable to make it flexible for dynamic row selections.

2. 替换删除行为清除指定区域内容 #

Instead of deleting the entire row with Rows(sourceRow).Delete, we'll use ClearContents on the same target range to erase only the cell values, leaving the row structure intact.

完整修改后的代码 #

Sub MoveSpecifiedRange()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim sourceRow As Integer
    Dim sourceRange As Range
    Dim targetPasteStart As Range
    
    ' Set your worksheet references (adjust sheet names if needed)
    Set sourceSheet = ThisWorkbook.Sheets("Sheet1")
    Set targetSheet = ThisWorkbook.Sheets("Sheet2")
    
    ' Example: Use row 8 as the source (replace this with your logic to find the correct row based on column values)
    sourceRow = 8
    
    ' Define the exact range to copy (C to J on the target row)
    Set sourceRange = sourceSheet.Range("C" & sourceRow & ":J" & sourceRow)
    
    ' Find the next empty row in the target sheet, starting at column C to match the source range
    Set targetPasteStart = targetSheet.Cells(targetSheet.Rows.Count, "C").End(xlUp).Offset(1, 0)
    
    ' Copy and paste the range
    sourceRange.Copy targetPasteStart
    
    ' Clear only the content of the source range (instead of deleting the row)
    sourceRange.ClearContents
End Sub

动态行匹配拓展（基于某列值判断） #

If you need to find the row dynamically based on a value in a specific column (e.g., find rows where column A equals "Ready to Move"), add this loop:

Sub MoveDynamicRange()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim sourceRow As Integer
    Dim sourceRange As Range
    Dim targetPasteStart As Range
    
    Set sourceSheet = ThisWorkbook.Sheets("Sheet1")
    Set targetSheet = ThisWorkbook.Sheets("Sheet2")
    
    ' Loop through all rows in column A to find matching values
    For sourceRow = 1 To sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
        ' Replace "Ready to Move" with your target value
        If sourceSheet.Cells(sourceRow, "A").Value = "Ready to Move" Then
            Set sourceRange = sourceSheet.Range("C" & sourceRow & ":J" & sourceRow)
            Set targetPasteStart = targetSheet.Cells(targetSheet.Rows.Count, "C").End(xlUp).Offset(1, 0)
            
            sourceRange.Copy targetPasteStart
            sourceRange.ClearContents
        End If
    Next sourceRow
End Sub

This code will only copy the C:J range of matching rows, paste them to the target sheet, and clear the original range's content without deleting any rows.

内容的提问来源于stack exchange，提问作者Rene Bourgoin