基于G列值复制行内容至指定工作表的Excel VBA需求

嘿，你这段代码的思路已经很清晰了！我来帮你把它补全并优化，实现根据G列值把数据分发到对应工作表指定区域的功能👇

Sub DistributeDataByGColumn()
    Dim sourceWS As Worksheet
    Dim targetWS As Worksheet
    Dim lastRowSource As Long
    Dim currentRow As Long
    Dim sheetName As String
    Dim targetRange As String
    Dim lastRowTarget As Long
    
    ' 替换成你的数据源工作表名称（就是CSV数据导入的那个表）
    Set sourceWS = ThisWorkbook.Worksheets("数据源")
    
    ' 获取数据源表中B列的最后一行（和你原代码的逻辑一致）
    lastRowSource = sourceWS.Cells(sourceWS.Rows.Count, "B").End(xlUp).Row
    
    ' 遍历每一行数据（假设表头在第1行，从第2行开始处理）
    For currentRow = 2 To lastRowSource
        ' 读取当前行C列的目标工作表名称
        sheetName = sourceWS.Range("C" & currentRow).Value
        
        ' 检查工作表是否存在，不存在就新建
        If Not SheetExists(sheetName) Then
            Set targetWS = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
            targetWS.Name = sheetName
        Else
            Set targetWS = ThisWorkbook.Worksheets(sheetName)
        End If
        
        ' 根据G列的值确定要粘贴到目标表的哪个区域
        Select Case sourceWS.Range("G" & currentRow).Value
            Case 1
                ' 这里改成G=1时对应的目标列，比如要粘到A列就写"A"
                targetRange = "A"
            Case 2
                ' G=2时的目标列
                targetRange = "D"
            Case 3
                ' G=3时的目标列
                targetRange = "G"
            Case Else
                ' 如果G列不是1/2/3，弹出提示并跳过该行
                MsgBox "第" & currentRow & "行的G列值无效，已跳过该行处理", vbExclamation
                GoTo NextRow
        End Select
        
        ' 找到目标区域的首个空行
        lastRowTarget = targetWS.Cells(targetWS.Rows.Count, targetRange).End(xlUp).Row
        ' 处理新工作表的情况：如果目标列第一行是空的，就从第1行开始粘贴
        If lastRowTarget = 1 And targetWS.Range(targetRange & "1").Value = "" Then
            lastRowTarget = 1
        Else
            lastRowTarget = lastRowTarget + 1
        End If
        
        ' 复制当前行的指定列数据到目标区域（这里是A-F列，可按需修改）
        sourceWS.Range("A" & currentRow & ":F" & currentRow).Copy _
            Destination:=targetWS.Range(targetRange & lastRowTarget)
        
NextRow:
    Next currentRow
    
    MsgBox "数据分发完成啦！", vbInformation
End Sub

' 完善后的工作表存在性检查函数
Function SheetExists(sheetName As String, Optional wb As Workbook) As Boolean
    Dim ws As Worksheet
    
    ' 默认检查当前工作簿，也可以传入其他工作簿对象
    If wb Is Nothing Then Set wb = ThisWorkbook
    
    On Error Resume Next
    Set ws = wb.Worksheets(sheetName)
    On Error GoTo 0
    
    ' 如果找到工作表就返回True，否则False
    SheetExists = Not ws Is Nothing
End Function

• 数据源表指定：一定要把Set sourceWS = ThisWorkbook.Worksheets("数据源")里的"数据源"改成你实际存放CSV导入数据的工作表名称
• 目标区域自定义：在Select Case部分，你可以根据业务需求修改每个G列值对应的targetRange，比如G=1时要粘贴到目标表的B列，就改成targetRange = "B"
• 复制列范围调整：sourceWS.Range("A" & currentRow & ":F" & currentRow)是当前行要复制的列范围（A到F），你可以改成需要的列，比如要复制A-E列就写"A" & currentRow & ":E" & currentRow
• 空行判断优化：处理了新工作表目标列为空的情况，避免出现新表第一行空着、从第二行开始粘贴的问题
• 错误处理：加入了G列值无效的提示，避免程序卡住

1. 确保你的CSV导入逻辑已经能正常把数据放到数据源表的首个空行
2. 建议先在测试文件上运行代码，确认功能正常后再用到正式文件
3. 如果目标工作表已经存在，代码会自动追加数据到指定区域的首个空行，不会覆盖原有数据

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