基于多条件将Worksheet 1数据转至Worksheet 2/3/4的VBA求助

Hey there! Let's walk through how to build this conditional data transfer tool for you. Since you're new to VBA, I'll break down every part so you understand what's happening along the way.

完整代码实现 #

Sub ConditionalDataTransfer()
    ' 声明变量：源工作表、目标工作表、循环计数器、目标区域字符串
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim i As Long
    Dim targetRange As String
    Dim lastCell As Range
    
    ' 设置源工作表（确保名称和你的实际工作表一致）
    Set wsSource = ThisWorkbook.Worksheets("Worksheet 1")
    
    ' 遍历源工作表A列的所有非空行（从第1行开始，有表头的话改成2）
    For i = 1 To wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
        ' 只处理A列值为"Are"的行
        If wsSource.Cells(i, "A").Value = "Are" Then
            ' 根据B列值确定目标工作表
            Select Case wsSource.Cells(i, "B").Value
                Case 2
                    Set wsTarget = ThisWorkbook.Worksheets("Worksheet 2")
                Case 3
                    Set wsTarget = ThisWorkbook.Worksheets("Worksheet 3")
                Case 4
                    Set wsTarget = ThisWorkbook.Worksheets("Worksheet 4")
                Case Else
                    ' 如果B列不是2/3/4，跳过当前行
                    GoTo NextRow
            End Select
            
            ' 根据C列值确定目标粘贴区域
            Select Case wsSource.Cells(i, "C").Value
                Case "You"
                    targetRange = "C12:C19"
                Case "me"
                    targetRange = "C20:C29"
                Case Else
                    ' 如果C列不是"You"或"me"，跳过当前行
                    GoTo NextRow
            End Select
            
            ' 找到目标区域的最后一个非空单元格
            Set lastCell = wsTarget.Range(targetRange).Find( _
                What:="*", _
                SearchDirection:=xlPrevious, _
                SearchOrder:=xlByRows _
            )
            
            ' 粘贴D列的值到目标区域的下一个空单元格
            If lastCell Is Nothing Then
                ' 区域为空，从第一个单元格开始粘贴
                wsTarget.Range(targetRange).Cells(1).Value = wsSource.Cells(i, "D").Value
            Else
                ' 检查是否还有空单元格在指定区域内
                If lastCell.Row < wsTarget.Range(targetRange).Rows(wsTarget.Range(targetRange).Rows.Count).Row Then
                    lastCell.Offset(1, 0).Value = wsSource.Cells(i, "D").Value
                Else
                    ' 区域已满，弹出提示
                    MsgBox "目标工作表" & wsTarget.Name & "的" & targetRange & "区域已填满，无法粘贴第" & i & "行的数据！"
                End If
            End If
        End If
NextRow:
    Next i
    
    ' 完成提示
    MsgBox "条件数据迁移已完成！"
End Sub

代码逐段解释 #

• 变量声明：我们先定义了几个关键变量，用来存储工作表对象、循环行数、目标区域等，让代码更清晰易维护。
• 源工作表设置：Set wsSource = ThisWorkbook.Worksheets("Worksheet 1") 绑定你要读取数据的工作表，记得把名称改成你实际使用的表名。
• 循环遍历行：wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row 会自动找到A列最后一行有数据的行号，避免循环空行浪费资源。
• A列条件判断：只有当A列单元格值等于"Are"时，才会进入后续处理逻辑。
• B列匹配目标工作表：用Select Case判断B列的值，分别绑定到对应的Worksheet 2/3/4，如果B列不是这三个值，就跳过当前行。
• C列匹配目标区域：同样用Select Case确定要粘贴到的区域，不符合条件的行直接跳过。
• 粘贴数据逻辑：先找到目标区域的最后一个非空单元格，然后把D列的值粘贴到下一个空位置；如果区域已经填满，会弹出提示告诉你哪一行的数据没粘贴成功。

注意事项 #

1. 确保你的工作表名称和代码里的"Worksheet 1"、"Worksheet 2"等完全一致（包括空格和大小写）。
2. 如果你的数据有表头（比如第1行是标题），记得把循环的起始行i = 1改成i = 2。
3. 可以根据自己的需求调整错误提示，或者添加更多的条件分支。

内容的提问来源于stack exchange，提问作者V. Malla