我来帮你修复这段代码的问题，同时完美适配你的需求——无需指定当前工作簿文件名，并且正确将userinput工作表的D9:D20数据追加到statistics.xlsx的stats工作表B-M列的新行中。

原代码的核心问题 #

• 语法错误：With Workbooks("statistics.xlsx").Worksheets("Stats 缺少闭合的引号和括号，直接导致VB编辑器报错
• 硬编码当前工作簿名称：Workbooks("Flat File.xlsm").Activate 限制了代码只能在特定文件名的工作簿运行
• 循环逻辑不符合需求：原循环是复制整行多列，而你只需要复制D9:D20这12个单元格到目标表的B-M列
• 变量未声明：NewRow、LastRow等变量没有提前声明，容易引发隐性错误
• Workbooks.Close语法错误：参数CloseChanges应为SaveChanges，拼写错误导致功能失效

修改后的完整代码 #

Option Explicit ' 强制变量声明，避免隐式变量引发的错误

Public Sub TransferData()
    '----------------------------------------------
    ' DECLARE AND SET VARIABLES
    Dim FilePath As String
    Dim targetWB As Workbook
    Dim sourceWS As Worksheet
    Dim targetWS As Worksheet
    Dim newRow As Long
    Dim sourceRange As Range
    
    FilePath = "E:\statistics.xlsx"
    Set sourceWS = ThisWorkbook.Worksheets("userinput") ' 指代当前存放代码的工作簿，无需硬编码文件名
    Set sourceRange = sourceWS.Range("D9:D20") ' 要复制的源数据范围
    '----------------------------------------------
    
    ' CHECK IF STATISTICS FILE IS OPEN
    If FileAlreadyOpen(FilePath) = True Then
        ' 文件已被占用，1分钟后自动重试
        Application.OnTime Now + TimeValue("00:01:00"), "TransferData"
        With sourceWS.CommandButton1
            .Enabled = False
            .Caption = "Saving... Please wait"
        End With
    Else
        ' 文件未打开，打开并处理数据
        Set targetWB = Workbooks.Open(FilePath)
        Set targetWS = targetWB.Worksheets("Stats")
        
        ' 找到目标表B列的下一个空行（因为要从B列开始粘贴数据）
        newRow = targetWS.Cells(targetWS.Rows.Count, "B").End(xlUp).Row + 1
        
        ' 直接将源数据赋值到目标区域：D9:D20共12个单元格，正好对应B-M列的12列
        targetWS.Range(targetWS.Cells(newRow, "B"), targetWS.Cells(newRow, "M")).Value = sourceRange.Value
        
        ' 保存并关闭目标工作簿
        targetWB.Close SaveChanges:=True
        
        ' 恢复按钮状态
        With sourceWS.CommandButton1
            .Enabled = True
            .Caption = "Transfer Data"
        End With
        
        MsgBox "Global Journal updated"
    End If
End Sub

Function FileAlreadyOpen(FullFileName As String) As Boolean
    ' 判断文件是否已被其他进程打开
    Dim f As Integer
    f = FreeFile
    On Error Resume Next
    Open FullFileName For Binary Access Read Write Lock Read Write As #f
    Close #f
    If Err.Number <> 0 Then
        FileAlreadyOpen = True
        Err.Clear
    Else
        FileAlreadyOpen = False
    End If
    On Error GoTo 0
End Function

关键修改说明 #

• Option Explicit：添加在模块顶部，强制所有变量必须声明，避免因拼写错误或隐式变量导致的奇怪问题
• 无需硬编码当前工作簿：用ThisWorkbook指代存放这段代码和按钮的工作簿，不管你重命名多少次都能正常运行
• 简化数据复制逻辑：直接将D9:D20的12个单元格值赋值给目标表的B-M列对应行，不需要嵌套循环，更高效简洁
• 修复语法错误：补全With语句的闭合符号，修正Workbooks.Close的参数拼写
• 明确变量类型：将newRow声明为Long（Excel行数可能超过Integer的最大值），使用对象变量让代码更清晰易读
• 基于B列找空行：因为要从B列开始粘贴数据，所以目标表的空行判断基于B列，避免A列有数据导致的错误

内容的提问来源于stack exchange，提问作者Jesper Kindt Larsen