注：在View -> Toolbar -> View 下调出编辑，可以看到“Comment Block”

Shift + F8 调试下一行

Alt +　F8 调出宏

字符串，数值在定义之后，可以直接赋值

Workbooks 集合包含 Microsoft Excel 中所有当前打开的 Workbook 对象。

application.transpose 转置

找值

http://zhidao.baidu.com/question/180864693.html

下面是最终版本，能实现按年份匹配的

Sub Mycopy()    Dim n As Integer Dim companylist As Range Dim companyname As Object Dim SourceBook As Workbook Dim SourceSheet As Worksheet Dim myrange As String n = 2   ThisWorkbook.Activate Set companylist = Range("B2:B214")   For Each companyname In companylist    Path = "C:\Users\WilliamDong\Dropbox\数据\EXCEL\" & companyname & ".xlsx"        If Dir(Path) "" Then                 Set mydictionary = CreateObject("Scripting.Dictionary")             Set SourceBook = Workbooks.Open(Path, 0, True)             Set SourceSheet = SourceBook.Worksheets(1)             For i = 2 To 9 Step 1          ' C2:C9  所需数据的年份范围                     If SourceSheet.Range("C" & i) "" Then                        mydictionary.Add SourceSheet.Range("C" & i).Value, SourceSheet.Range("L" & i).Value                                             End If             Next i                         dic_keys = mydictionary.keys            dic_items = mydictionary.items                          ' 下面遍历字典，把值拿出来赋给另一个Excel表中对应的位置E2:L2,对应2005~~2012             For j = 0 To mydictionary.Count - 1                     Dim indexNum As String                                  Select Case dic_keys(j)                     Case 2005                        indexNum = "E" & n                     Case 2006                        indexNum = "F" & n                     Case 2007                        indexNum = "G" & n                     Case 2008                        indexNum = "H" & n                     Case 2009                        indexNum = "I" & n                     Case 2010                        indexNum = "J" & n                     Case 2011                        indexNum = "K" & n                     Case 2012                        indexNum = "L" & n                     End Select                                                               ThisWorkbook.Worksheets(1).Range(indexNum) = dic_items(j)             Next                                     SourceBook.Close False    Else        End If          n = n + 1         Next companyname End Sub

最终的（没能实现按不同年份匹配）

Sub Mycopy()    Dim n As Integer Dim companylist As Range Dim companyname As Object Dim SourceBook As Workbook Dim SourceSheet As Worksheet Dim myrange As String n = 2 ThisWorkbook.Activate Set companylist = Range("B2:B214")   For Each companyname In companylist    Path = "C:\Users\WilliamDong\Dropbox\数据\EXCEL\" & companyname & ".xlsx"        If Dir(Path) "" Then        Set SourceBook = Workbooks.Open(Path, 0, True)    Set SourceSheet = SourceBook.Worksheets(1)    RANGE_ = SourceSheet.Range("L2:L9")         myrange = "E" & n & ":" & "L" & n          ThisWorkbook.Activate     ThisWorkbook.Worksheets(1).Range(myrange) = WorksheetFunction.Transpose(RANGE_)    '写入数据             SourceBook.Close False    Else        End If          n = n + 1         Next companyname End Sub

之前（1）

在Excel表1中写入如下宏

Sub CopyData()         Dim r1 As Range   Dim r2 As Range   Dim w As Workbook   ThisWorkbook.Activate   Set r1 = ThisWorkbook.Sheets(1).[a1]   Set r2 = ThisWorkbook.Sheets(1).[c1]     Set w = Workbooks.Open(ThisWorkbook.Path & "\Test2.xlsx") ‘Test2是另一个Excel表   w.Sheets(1).[b1] = r1   w.Sheets(1).[b2] = r2   w.Save   w.Close

End Sub

之前（2）

Sub Mycopy()    Dim FSO As Object Dim SourceFolder As Object Dim FileItem As Object Dim FileItemToUse As Object Dim SourceFolderName As String Dim n As Integer Dim myrange As String n = 2 SourceFolderName = "C:\Users\William\Dropbox\数据\EXCEL" Set FSO = CreateObject("Scripting.FileSystemObject") Set SourceFolder = FSO.GetFolder(SourceFolderName) For Each FileItem In SourceFolder.Files '下面就可接着写打开文件读取数据再写入的语句了,如下: fn = FileItem Workbooks.Open Filename:=fn Worksheets(1).Select '假设你读取SHEET1的数据 RANGE_ = Range("L2:L9") '需要数据的区域,自己修改 ThisWorkbook.Activate  '这个是新表的文件名,自己修改下 Worksheets(1).Select '打开第几个文件就选择SHEET几,如果没有可用ADD代码添加 myrange = "E" & n & ":" & "L" & n Range(myrange) = RANGE_ '写入数据 Workbooks(2).Close n = n + 1 'End If Next FileItem End Sub

底下是网上参考