如何通过VBA将同一值同步至Excel两个工作表？代码修改需求

以下是修改后的完整VBA代码，直接替换你Sheet1中的现有宏即可，它会在双击Sheet1的D列单元格时触发文件选择，完成文件路径写入D列、项目名称写入对应行E列，同时将目标文件数据导入Sheet2的功能。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    '仅允许双击D列（第4列）单元格时触发
    If Target.Column <> 4 Then Exit Sub
    
    Dim filePath As Variant
    Dim OpenBook As Workbook
    Dim projectName As String
    
    '弹出文件选择对话框，仅允许选择Excel文件
    filePath = Application.GetOpenFilename("Excel Files (*.xlsx; *.xls), *.xlsx; *.xls", Title:="选择要提取数据的文件")
    
    '如果用户取消选择，直接退出
    If filePath = False Then Exit Sub
    
    '将文件路径写入当前双击的D列单元格
    Target.Value = filePath
    
    '打开选中的文件（只读模式，避免锁定原文件）
    Set OpenBook = Application.Workbooks.Open(filePath, ReadOnly:=True)
    
    '提取项目名称（Extracts工作表的B1单元格）
    projectName = OpenBook.Sheets("Extracts").Range("B1").Value
    
    '将项目名称写入当前行的E列（D列右侧一列）
    Target.Offset(0, 1).Value = projectName
    
    '===== 以下保留你原有的导入Sheet2数据的逻辑即可 =====
    '示例：将Extracts工作表指定区域数据复制到Sheet2的最后一行
    OpenBook.Sheets("Extracts").Range("A2:C100").Copy
    ThisWorkbook.Sheets("Sheet2").Range("A" & ThisWorkbook.Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial xlPasteValues
    
    '关闭打开的文件，不保存更改
    OpenBook.Close SaveChanges:=False
    
    '取消默认双击进入编辑模式的行为
    Cancel = True
End Sub

关键修改说明 #

• 触发范围限制：通过If Target.Column <> 4 Then Exit Sub确保只有双击D列单元格时才执行后续逻辑，防止误触其他列。
• 对应行E列写入：使用Target.Offset(0, 1)定位到当前触发单元格的右侧E列单元格（Offset(行偏移, 列偏移)，此处列偏移+1即为E列），直接写入提取到的项目名称。
• 文件操作优化：打开文件时启用ReadOnly:=True避免锁定原文件，关闭时不保存更改，防止破坏源文件内容。

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