VBA代码修改需求：复制修剪范围时按L列值替换目标A列

Sub export_trimmed_Selection()
    Const headerRow As Long = 2
    
    Dim swb As Workbook, sh As Worksheet
    Dim rng As Range, TrimmedRange As Range, selc As Range
    Dim srg As Range, dwb As Workbook, drg As Range, rr As Range
    Dim sourceRow As Long, targetRow As Long
    
    Set swb = ThisWorkbook              '源工作簿
    Set sh = ActiveSheet
    '获取选中的可见行（与已用区域交集）
    Set selc = Intersect(sh.UsedRange, Selection.EntireRow.SpecialCells(xlCellTypeVisible))
    
    If selc Is Nothing Then Exit Sub '无有效选中行时直接退出
    
    Set rng = selc
    Set TrimmedRange = Intersect(rng, sh.UsedRange)
    Set srg = Intersect(TrimmedRange.EntireRow, sh.Range("A:B,D:E,H:H,J:K"))
    
    '将表头合并到要复制的区域
    For Each rr In srg.Areas
        If srg Is Nothing Then
            Set srg = Union(rr, rr.EntireColumn.Rows(headerRow))
        Else
            Set srg = Union(srg, rr, rr.EntireColumn.Rows(headerRow))
        End If
    Next
    
    '创建新工作簿并复制数据及列宽
    Set dwb = Workbooks.Add
    Set drg = dwb.Sheets(1).Range("A1")
    
    srg.Copy
    drg.PasteSpecial Paste:=xlPasteColumnWidths
    srg.Copy drg
    
    '新增逻辑：根据源行L列值替换目标行A列
    Dim sourceCell As Range
    '遍历选中的每一行（跳过表头行）
    For Each sourceCell In selc.Rows
        sourceRow = sourceCell.Row
        If sourceRow > headerRow Then
            '计算目标行号：表头占1行，数据行对应关系为 目标行=源行-表头行+1
            targetRow = sourceRow - headerRow + 1
            '检查源行L列是否有内容
            If sh.Cells(sourceRow, "L").Value <> "" Then
                '替换目标工作簿对应行的A列
                dwb.Sheets(1).Cells(targetRow, "A").Value = sh.Cells(sourceRow, "L").Value
            End If
        End If
    Next
End Sub

• 移除原代码中未初始化的uRng变量，新增空选中行判断，避免无有效数据时报错
• 保留原代码复制指定列、表头、列宽的核心逻辑
• 新增遍历校验逻辑：
  1. 跳过表头行，只处理数据行
  2. 匹配源工作簿与目标工作簿的行对应关系
  3. 检查源行L列值，非空则替换目标行A列内容

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