点击蓝字
关注我们大家遇到过以下场景类似的问题：下载了全部区域客户的数据资料后，需要分区域发送给各区域负责人进行数据核对，并在收齐后再将所有数据合并导入覆盖原先数据最常规的操作是，将数据按照区域排序或筛选，再新建excel文件，把筛选的内容粘贴到新的文件中去。
等收齐后再打开所有的文件将内容复制粘贴到同一个excel文件中这种操作方式可能是大家最常用的方法，区域少还好，如果有超过50甚至更多区域时，就显得很繁琐并且容易出错了(本文以office2007以上版本为例)。
快速将筛选内容另存为单个文件今天给大家提供一种快速将筛选内容另存为单个文件，还有快速将多个excel文件中的数据合并到一个文件中的方法，话不多说，直接上干货假设以下表格为全部区域的客户资料数据，需要以 “区域”进行筛选，并把筛选出来的内容另存为新的excel文件，新的文件名称为筛选的“区域”值，如筛选出区域为”河北”的内容另存为”河北.xlsx”，以此类推。
1、打开[开发工具]- [宏安全性]：将宏设置选中“禁用所有宏，并发出通知”，否则代码无法运行。
2、在Excel页面空白处建立一个命令按钮 打开[开发工具]-[插入]-[ActiveX控件]，选择第一个长方形命令按钮，在空白处画一个命令按钮，如下图：
3、双击命令按钮，跳出如下Visual Basic编辑器：
4、在VB编辑器中输入如下代码：Private Sub CommandButton1_Click() Set newbk = Workbooks.Add [a1].AutoFilter 2, (Range("
f1").Value) [a1].CurrentRegion.SpecialCells(xlCellTypeVisible).Copy newbk.Sheets(1).[a1]x = (Range("f1
").Value) ActiveWorkbook.SaveAs "e:" & x & ".xlsx" ActiveWorkbook.Close True Application.ScreenUpdating = True
End Sub这段代码是最核心的内容了，请大家注意红色的字体标出的内容，如果您对代码不熟悉，其他的地方建议不要改动，只需将红色字体的内容修改成您的实际操作环境时的内容即可下面稍微解释一下红色的地方如何修改吧。
[a1].AutoFilter 2, (Range("f1").Value) 先说这个2，因为此例子中要筛选的“区域”列在第二列，所以是2，您的筛选列在第几列，这个地方就改为几再说这个f1,意思是根据单元格f1中的内容来筛选，也可以为其他单元格，相应修改就行，如f1中的值为”河北”，就代表我需要将区域列中内容为”河北”的内容另存为“河北.xlsx”,。
x = (Range("f1").Value) 这个f1跟之前那个f1必须保持一致，如要修改，两者一起改ActiveWorkbook.SaveAs "e:" & x & ".xlsx" 把新建的工作簿保存到。
e盘根目录下，您也可以改为其他盘符5、关闭VB编辑器，保存一下，然后关闭表格再次打开表格，在单元格f1中输入“河北”（就是第二列中需要进行筛选的内容），然后按一下命令按钮，你会发现屏幕闪了一下，打开e盘，可以看到一个名为河北.xlsx的新文件，而原来的表格则变为如下样子：。
继续在f1中输入”河南”，点击命令按钮，就会在e盘得到名为河南.xlsx的文件，依次类推将筛选的内容做成选取至此基本功能实现了，但是单元格f1中每次输入难免会有错误，而且当内容比较多时，反复输入也是挺麻烦的，因此我们可以在f1单元格中作一个数据有效性列表，从中选取，具体操作如下：首先要做一些准备工作：。
1、使用高级筛选， “区域”列的所有不重复记录，然后把这些不重复记录复制粘贴到sheet2，列A中；
2、选中sheet2列A，打开[公式]-[定义名称]：给sheet2列A定义一个名称，如abc
3、设置数据有效性：回到sheet1，选中单元格f1，打开[数据]-[有效性]，跳出一个对话框，在“允许”中选择“序列”，“来源”中填写“=abc”，此时在单元格f1的右侧会出现下拉箭头，点击一下就能看到下拉列表中出现了“河北”“河南”“山东”，这样只要在列表中选择想要筛选的数值即可，免去了输入的麻烦。
批量将多个xlsx文件数据合并做完了拆分，下面我们来看看和合并，详细步骤：1、新建一个文件夹2、将要合并的表格放到里面3、新建一个表格4、用excel打开5、右击Sheet1选择查看代码6、将下列代码复制到文本框中：。
Sub hebing()Dim MyPath, MyName, AWbNameDim Wb As workbook, WbN As StringDim G As LongDim Num As Long
Dim BOX As StringApplication.ScreenUpdating = FalseMyPath = ActiveWorkbook.PathMyName = Dir(MyPath & "\" & "*.
xlsx")AWbName = ActiveWorkbook.NameNum = 0Do While MyName <> ""If MyName <> AWbName ThenSet Wb = Workbooks.Open(MyPath & "\" & MyName)
Num = Num + 1With Workbooks(1).ActiveSheet.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
For G = 1 To Sheets.CountWb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)Next
WbN = WbN & Chr(13) & Wb.NameWb.Close FalseEnd WithEnd IfMyName = DirLoop ★ Range("B1").SelectApplication.ScreenUpdating = True
MsgBox "共合并了" & Num & "个工作薄下的全部工作表如下：" & Chr(13) & WbN, vbInformation, "提示"End Sub7、代码中★替换成换行,点击运行，即可成功合并。
注意：文中所有提到xlsx文件的地方，如果您使用的是低版本excel,请自行修改为xls。想获得更多excel办公小技巧，请关注“职场攻守范”公众号吧！
扫二维码｜关注我们微信号｜WorkplaceFan新浪微博｜职场攻守范点击 在看或分享让更多人看到吧
亲爱的读者们，感谢您花时间阅读本文。如果您对本文有任何疑问或建议，请随时联系我。我非常乐意与您交流。
发表评论:
◎欢迎参与讨论，请在这里发表您的看法、交流您的观点。