想把姓名汇总到单元格怎么不行呢？高手看看

cocobobo

1. Sub 汇总()
   
2.    Dim myPath$, myFile$, AK As Workbook, tcol%, i As Integer
   
3.    Application.ScreenUpdating = False
   
4.    myPath = ThisWorkbook.Path & ""
   
5.    myFile = Dir(myPath & "*.xls")
   
6.    Do While myFile <> ""
   
7.       If myFile <> ThisWorkbook.Name Then
   
8.          Set AK = Workbooks.Open(myPath & myFile)
   
9.         For i = 3 To 4
   
10.        AK.Sheet1.Range("d5").Copy ThisWorkbook.Sheets(1).Cells(i, 2) '把姓名复制进去，报错！？
    
11.         Next
    
12. Workbooks(myFile).Close False
    
13.       End If
    
14.       myFile = Dir
    
15.    Loop
    
16.    Application.ScreenUpdating = True
    
17.    MsgBox "汇总完成！", 64, "提示"
    
18. 老是出错，不知道哪里问题？
    
19. End Sub
    

复制代码

anzequ

AK.Sheets(1).Range("d5").Copy ThisWorkbook.Sheets(1).Cells(i, 2)

anzequ

AK.Sheets(1).Range("d5").Copy ThisWorkbook.Sheets(1).Cells(i, 2)

jjmysjg

anzequ 发表于 2018-8-10 23:41
AK.Sheets(1).Range("d5").Copy ThisWorkbook.Sheets(1).Cells(i, 2)

左均芝汇总进去2次，严峻没有汇入

lsc900707

代码放到模块里去啊。

DevilW

Sub 汇总()
    Dim myPath$, myFile$, AK As Workbook, tcol%, i As Integer
    Application.ScreenUpdating = False
    myPath = ThisWorkbook.Path & "\"
    myFile = Dir(myPath & "*.xls")
    Do While myFile <> ""
        If myFile <> ThisWorkbook.Name Then
            Set AK = Workbooks.Open(myPath & myFile)
            i = i + 1   '取消内循环，利用外循环 +1 计步
            AK.Sheets(1).Range("d5").Copy ThisWorkbook.Sheets(1).Cells(i + 2, 2)
            Workbooks(myFile).Close False
        End If
        myFile = Dir
    Loop
    Application.ScreenUpdating = True
    MsgBox "汇总完成！", 64, "提示"
End Sub

xiangbaoan

AK.Sheet1      不能这么用，可如下：
ak.sheets(1)  '工作表的索引号
ak.sheets("表一")   '工作表的名称