VBA代码无法将数据粘贴到Excel表格表头下方空行问题求助

问题原因 #

你当前的代码是按普通单元格区域的逻辑定位粘贴位置，没有适配Excel结构化表格（即「插入」选项卡中创建的正式表格）的特性，所以粘贴的内容不会自动并入表格，只会出现在表格下方的独立单元格区域。

修改后的完整代码 #

保留了你要求的基础易懂语法，原有功能逻辑全部不变，仅新增了结构化表格的粘贴位置适配：

Sub Export()

Sheets("Export Format").Select

Cells(13, "D").Calculate

        With Range("A1", Cells(Rows.Count, "L").End(xlUp))  'reference its column A:G cells from row 1 (header) down to last not empty one in column "A"
            
            .AutoFilter Field:=6, Criteria1:="<>0" ' filter referenced cells on 6th column with everything but "0" content
            
            If Application.WorksheetFunction.Subtotal(103, .Columns(1)) > 1 Then
                
                .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy ' copy filtered cells skipping headers
                
                With Workbooks.Open(Filename:="Z:\Tracking\Database.xlsx").Sheets("Sheet1") 'open wanted workbook and reference its wanted sheet
                    Dim targetTbl As ListObject
                    ' 定位目标表的结构化表格，若表格有自定义名称可改为 .ListObjects("你的表格名")
                    Set targetTbl = .ListObjects(1)
                    Dim pasteRng As Range
                    ' 定位表格内部第一个空白行
                    If targetTbl.DataBodyRange Is Nothing Then
                        ' 表格只有表头无数据，直接粘贴到表头下方
                        Set pasteRng = targetTbl.HeaderRowRange.Offset(1, 0)
                    Else
                        ' 表格有现有数据，粘贴到最后一行数据的下方
                        Set pasteRng = targetTbl.DataBodyRange.Cells(targetTbl.ListRows.Count, 1).Offset(1, 0)
                    End If
                    ' 执行粘贴
                    pasteRng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone _
                    , SkipBlanks:=False, Transpose:=False
                    
                    .Parent.Close True 'Save and closes referenced workbook
                
                End With
                
                Application.CutCopyMode = False
            
            End If
        
        End With
        
        On Error Resume Next
        Sheets("Export Format").ShowAllData 'Clears Filters
        On Error GoTo 0
        
        Sheets("Export Format").Select 'Brings back to Main request sheet
    
End Sub

可修改参数说明 #

• 若目标表格有自定义名称，将Set targetTbl = .ListObjects(1)中的1替换为你的表格名称，用双引号包裹即可，示例：Set targetTbl = .ListObjects("库存记录表")
• 其余原有逻辑（筛选条件、文件路径、粘贴规则等）均和你原来的代码一致，可按原有习惯修改

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