VBA问题：获取各工作表最后一列数据并粘贴至新工作表

问题说明 #

刚接触VBA，想要获取每个工作表中最后一列的已填充单元格数据，将所有这些值粘贴到单个工作表的下一行空白行中，避免覆盖原有值。现有代码在为LastCol变量分配区域时存在问题，需要修正。

原代码：

Sub ExtractLastColumn()

Dim ws As Worksheet
Dim sht As Worksheet
Dim wrk As Workbook
Dim LastCol As Range
Dim LastRow As Range

'Create new sheet and combine tabs

Set wrk = ActiveWorkbook 'Working in active workbook

 'Add new worksheet as the last worksheet called INSERTS
 
    With ThisWorkbook
        Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
        ws.Name = "INSERTS"
    End With


 'loop to get values from last column on each worksheets and paste into new INSERTS sheet
For Each sht In wrk.Worksheets
If sht.Name <> "INSERTS" And sht.Name <> ws.Name Then

    'get range of populated cells in last populated column
    LastCol = Cells(1, Columns.Count).End(xlToLeft).Value
    
   'get next empty row on INSERTS sheet
    Worksheets("INSERTS").Activate
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1

     'paste range from sheet into next emtpy row for INSERTS sheet
     Worksheets(sht).Range(LastCol).Copy Worksheets("INSERTS").Range(LastRow)

End If
Next sht

End Sub

原代码问题分析 #

• LastCol被定义为Range类型，但直接赋值.Value且未指定所属工作表，默认引用当前激活表，逻辑错误。
• LastRow被定义为Range类型，但实际存储的是行号，应该用Long类型。
• 复制粘贴时，Range(LastRow)写法错误，行号不能直接作为Range参数使用。
• 工作表名称判断冗余：sht.Name <> ws.Name多余，因为ws就是新建的"INSERTS"表，只需判断sht.Name <> "INSERTS"即可。
• 使用Activate切换工作表会降低代码稳定性，应直接通过对象引用操作。

修正后的代码 #

Sub ExtractLastColumn()
    Dim wsInserts As Worksheet
    Dim sht As Worksheet
    Dim wrk As Workbook
    Dim lastColNum As Long
    Dim lastRowInserts As Long
    Dim dataRange As Range
    
    ' 引用当前工作簿
    Set wrk = ActiveWorkbook
    
    ' 新建名为INSERTS的工作表（如果已存在则直接引用）
    On Error Resume Next
    Set wsInserts = wrk.Sheets("INSERTS")
    If Err.Number <> 0 Then
        Set wsInserts = wrk.Sheets.Add(After:=wrk.Sheets(wrk.Sheets.Count))
        wsInserts.Name = "INSERTS"
    End If
    On Error GoTo 0
    
    ' 遍历所有工作表
    For Each sht In wrk.Worksheets
        If sht.Name <> wsInserts.Name Then
            ' 获取当前工作表的最后一列列号
            lastColNum = sht.Cells(1, sht.Columns.Count).End(xlToLeft).Column
            
            ' 获取该列的已填充数据范围（从第1行到最后一行）
            Set dataRange = sht.Range(sht.Cells(1, lastColNum), sht.Cells(sht.Rows.Count, lastColNum).End(xlUp))
            
            ' 获取INSERTS表的下一个空白行（A列为准）
            lastRowInserts = wsInserts.Cells(wsInserts.Rows.Count, 1).End(xlUp).Row + 1
            
            ' 将数据复制到INSERTS表的空白行
            dataRange.Copy wsInserts.Cells(lastRowInserts, 1)
        End If
    Next sht
End Sub

关键代码解释 #

1. 处理INSERTS表的存在性：先尝试引用已有的"INSERTS"表，不存在再新建，避免重复创建报错。
2. 获取最后一列：通过sht.Cells(1, sht.Columns.Count).End(xlToLeft).Column准确获取当前工作表的最后一列列号，指定sht确保引用当前遍历的工作表。
3. 获取数据范围：从该列第1行到最后一个非空单元格，确保只复制已填充数据。
4. 获取空白行：通过wsInserts.Cells(wsInserts.Rows.Count, 1).End(xlUp).Row + 1获取INSERTS表A列的下一个空白行，避免覆盖原有数据。
5. 直接复制数据：无需激活工作表，直接通过对象引用完成复制操作，提升代码稳定性。

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