Excel VBA 修改跨工作簿复制代码实现动态区域拷贝求助

修改后的完整代码 #

Sub Test1()
  Dim lastRow As Long, lastCol As Long
  Dim WshtNames As Variant
  Dim WshtNameCrnt As Variant
  Dim WB1 As Workbook, WB2 As Workbook
  Dim srcWs As Worksheet, tgtWs As Worksheet
  
  Set WB1 = ActiveWorkbook
  Set WB2 = Workbooks.Open("C:\NOT_ORG.xlsx")

  WshtNames = Array("2", "3")
  For Each WshtNameCrnt In WshtNames
    ' 绑定源表和新创建的目标表
    Set srcWs = WB2.Worksheets(WshtNameCrnt)
    Set tgtWs = WB1.Sheets.Add
    tgtWs.Name = WshtNameCrnt & "_new"
    
    ' 计算源表A7开始的有效区域边界
    With srcWs
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        lastCol = .Cells(7, .Columns.Count).End(xlToLeft).Column
        
        ' 避免A7及以下无数据的异常情况
        If lastRow >= 7 Then
            .Range(.Cells(7, "A"), .Cells(lastRow, lastCol)).Copy tgtWs.Range("A1")
        End If
    End With
  Next WshtNameCrnt
  
  ' 可选：不需要保留打开的NOT_ORG.xlsx可取消注释下面这句，关闭文件不保存
  ' WB2.Close SaveChanges:=False
End Sub

核心修改说明 #

• 新增lastCol变量存储源表最后一列序号，同时新增srcWs、tgtWs两个工作表变量，简化重复引用逻辑，提升代码可读性
• 动态区域计算逻辑放在循环内部，每个源工作表单独计算自身有效数据范围：
  • lastRow取A列最后一个有内容的行号，覆盖A列所有有效数据行
  • lastCol取第7行（指定的复制起始行）最后一个有内容的列号，覆盖表头行所有有效列
• 替换原有单单元格复制语句，直接将A7到最后一行最后一列的完整区域复制到目标表A1起始位置
• 增加数据存在性判断：如果A7及以下无任何有效数据，不会执行复制操作，避免触发运行错误

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