借助deepseek和vba编程实现一张表格数据转移到多张工作簿的表格中

核心目标

• 将工作表中的内容按村社名称分类放入对应位置的目标工作簿的第一个工作表的对应位置
  
  

deepseek提问方式

• 你是一个擅长vba编程的专家，核心目标是奖工作表中的部分内容按下列要求写入对应工作簿的第一个工作表中。第一，在工作表A列中筛选出相同单元格内容的行，第二，选择单元格内容与“_2024年盘点表电子表”之前内容一致的工作簿的第一个表格；第三，将工作表中筛选出的行的C列至G列内容从工作簿的第一个表格的C5单元格开始写入。

vba代码

Sub TransferData()
    Dim srcWS As Worksheet, destWB As Workbook
    Dim lastRow As Long, i As Long, rng As Range
    Dim keyName As String, fileName As String
    Dim destWS As Worksheet
    
    Set srcWS = ThisWorkbook.Sheets("Sheet1") ' 源工作表
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    lastRow = srcWS.Cells(srcWS.Rows.Count, "A").End(xlUp).Row
    
    ' 创建字典用于分组
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 分组数据
    For i = 8 To lastRow ' 假设数据从第8行开始
        keyName = srcWS.Cells(i, 1).Value
        If keyName <> "" Then
            If Not dict.Exists(keyName) Then
                dict.Add keyName, New Collection
            End If
            dict(keyName).Add i
        End If
    Next i
    
    ' 处理每个分组
    Dim key As Variant, cell As Variant
    For Each key In dict.Keys
        fileName = ThisWorkbook.Path & "\" & key & "_2024年盘点表电子表.xls"
        
        If Dir(fileName) <> "" Then
            Set destWB = Workbooks.Open(fileName)
            Set destWS = destWB.Sheets(1)
            
            ' 查找目标起始行
            Dim startRow As Long
            startRow = 5 ' C5对应行号为5
            
            For Each cell In dict(key)
                ' 复制C-G列数据
                srcWS.Range("C" & cell & ":G" & cell).Copy
                destWS.Cells(startRow, 3).PasteSpecial xlPasteValues
                startRow = startRow + 1
            Next cell
            
            destWB.Close SaveChanges:=True
        Else
            MsgBox "未找到工作簿：" & fileName, vbExclamation
        End If
    Next key
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    MsgBox "数据转移完成！"
End Sub