怎样在excel中通过VBA在多个表格中提取同一行的数据

红提沙拉

大家好！我要在D盘-“提取”文件夹-46个工作表中提取同一行数据，每个表的格式相同
我在网上找到的代码，按照方法操作然后修改了行数，但是运行了无反应，请大家帮帮忙！！！
是哪里有问题呢？



Sub 汇总数据()
    Application.ScreenUpdating = False
    p = "d:\提取\"
    f = Dir(p & "*.xlsx")
    Do While f <> ""
        Workbooks.Open p & f
        r = r + 1


        ActiveSheet.Rows(13).Copy


Workbooks("汇总.xlsx").Sheets("sheet1").Activate
ActiveSheet.Range("A" & r).Select
ActiveSheet.Paste
Application.CutCopyMode = xlCut
Workbooks(f).Activate
ActiveWorkbook.Saved = True
        ActiveWindow.Close
        f = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

microyip

1. Workbooks("汇总.xlsx").Sheets("sheet1").Activate

复制代码

拆成

1. Workbooks("汇总.xlsx").Activate
   
2. Sheets("sheet1").Activate

复制代码

abc123281

欢迎新同学
   看了你提供的代码  方法不是很好
   可以说明详细需求和想要实现的效果  或许会有答案
   从代码看出你只复制了某一个人的数据   那其他人的数据如果想要汇总咋办？

红提沙拉

microyip 发表于 2019-12-15 12:53
拆成

还是不行  按F5运行表格没有变化

microyip

1. Sub 汇总数据()
   
2.     Dim sPath As String, vData As Variant, nRow As Integer, nCol As Integer, sFile As String
   
3.     Dim vFill As Variant, nFill As Variant
   
4.    
   
5.     Application.ScreenUpdating = False
   
6.     nRow = 13
   
7.     sPath = "d:\提取"
   
8.     sFile = Dir(sPath & "*.xlsx")
   
9.     ReDim vFill(1 To 9, 0)
   
10.     Do While sFile <> ""
    
11.         With Workbooks.Open(sPath & sFile)
    
12.             vData = .Sheets(1).UsedRange.Value
    
13.             .Close False
    
14.         End With
    
15.         nFill = nFill + 1
    
16.         ReDim Preserve vFill(1 To 9, 1 To nFill)
    
17.         For nCol = 1 To 9
    
18.             If nCol <= UBound(vData, 2) Then vFill(nCol, nFill) = vData(nCol, nRow)
    
19.         Next
    
20.         sFile = Dir
    
21.     Loop
    
22.     With Sheet1
    
23.         .UsedRange.ClearContents
    
24.         If nFill > 0 Then .[A1:I1].Resize(nFill) = Application.WorksheetFunction.Transpose(vFill)
    
25.     End With
    
26.     Application.ScreenUpdating = True
    
27. End Sub

复制代码

microyip

原来的写法本来就不怎么样。代码要审核，上图片给你抄吧

microyip

修正一下，vData(nRow,nCol)

红提沙拉

microyip 发表于 2019-12-15 16:05
修正一下，vData(nRow,nCol)

谢谢！但是还是没有反应我不明白了
[img][/img]

红提沙拉

红提沙拉

microyip 发表于 2019-12-15 16:05
修正一下，vData(nRow,nCol)

截图在下边