一、 背景
现在提供一个比较简单的功能，就是把每个工作簿里的第一个sheet合并到一个sheet中，这样的处理方式 ，我们经常用到。比如在处理一年中每个月的数据时，或处理每个店面的数据中，这些数据是分散在不同的工作簿中，处理起来并不方便，这时候就需要我们将要介绍的功能，合并多个工作薄中的指定sheet到一个sheet中。
二、 思路
通常来说处理多个工作簿时，需要把要处理的工作簿放在一个文件夹中，然后读取文件名称，然后一依次打开，将指定sheet的数据复制粘贴到指定的sheet中，处理完一个就关闭一个，这样循环处理所有的文件，就完成了数据的合并。
设计处理画面如下：
三、 操作
①点击浏览选择要处理文件所在文件夹
②点击执行计算按钮开始处理
四、 源代码及解析
源代码如下：
Private Sub CommandButton1_Click()
Dim inFolder As String: inFolder = GetFolderName(msoFileDialogFolderPicker)
Dim outFolder As String
ActiveSheet.Range("F11") = inFolder
End Sub
Public Function GetFolderName(ByVal DialogType As MsoFileDialogType) As String
With Application.FileDialog(DialogType)
If .Show = True Then
GetFolderName = .SelectedItems(1)
End If
End With
End Function
Private Sub CommandButton2_Click()
Dim GZDicList, GZFileList, GZFileName(), GZFilePath()
Dim strGZFoldPath As String
Set GZDicList = CreateObject("Scripting.Dictionary")
Set GZFileList = CreateObject("Scripting.Dictionary")
strGZFoldPath = ActiveSheet.Range("F11") & "\"
If strGZFoldPath = "\" Then
MsgBox ("未选择资原始数据目录")
Exit Sub
End If
'初始化目录
GZDicList.Add strGZFoldPath, ""
'取得全部文件名
i = 0
Do While i < GZDicList.Count
Key = GZDicList.keys '本次要遍历的目录
NowDic = Dir(Key(i), vbDirectory) '开始查找
Do While NowDic <> ""
If (NowDic <> ".") And (NowDic <> "..") Then
If (GetAttr(Key(i) & NowDic) And vbDirectory) = vbDirectory Then '找到子目录，则添加
GZDicList.Add Key(i) & NowDic & "\", ""
End If
End If
NowDic = Dir() '再找
Loop
i = i + 1
Loop
'**
'遍历目录中的所有文件*
For Each Key In GZDicList.keys '查找所有目录中的文件
NowFile = Dir(Key & "\.xls")
Do While NowFile <> ""
GZFileList.Add NowFile, Key 'Add(Key,Item) GZFileList.Key=文件名,GZFileList.Item=目录
NowFile = Dir()
Loop
Next
GZFileName() = GZFileList.keys
GZFilePath() = GZFileList.Items
'**
'添加一个sheet用来存放结果
ThisWorkbook.Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "结果"
Set shs = ActiveSheet
'Set shs = Sheets.Add(after:=Sheets(Sheets.Count))
pzRowMax = shs.Range("H65536").End(xlUp).Row
For j = 0 To UBound(GZFileName) - LBound(GZFileName)
Workbooks.Open Filename:=GZFilePath(j) & GZFileName(j)
Set tsh = Workbooks(GZFileName(j)).Sheets(1)
tsh.UsedRange.Copy
rRowMax = shs.Range("H65536").End(xlUp).Row
shs.Activate
shs.Range(shs.Cells(rRowMax + 1, 1), shs.Cells(rRowMax + 1, 1)).Select
ActiveSheet.Paste
Workbooks(GZFileName(j)).Close
Next
End Sub
部分代码解析：
这一块是浏览按钮的功能，这一块是相对固定的，可以直接拿到自已的代码里用。
这一块是主要是核心代码
这是判断界面上是不是选择了文件夹。
这是遍历文件夹，把文件名放到字典中。
添加一个sheet，并命名为【结果】，用来存放处理结果。
依次打开文件，复制区域粘贴到结果中，再关闭文件。
五、 执行效果
待处理数据：
执行结果：
总结：这样几行代码，就实现了从多个文件中复制区域到一个sheet中，想象一下，如果你要处理的数据几百个的话，那会提升多高的效率。如果对这个功能感兴趣的朋友，可以私信我，获取源文件。处理中可能存在一些不合理的地方，大家有好的建议也可以留言一块儿讨论一下。