查看: 1589|回复: 4
如何将同一个文件夹的不同工作薄的内容复制到另一个工作表的同名工作表里
阅读权限20
在线时间 小时
想把同一文件夹下的几个表格里的所有数据全部复制到另一个文件夹下的一个表格里面的同名工作表里面，数据多的有几千行，少的有几百行，每一个表格里的内容基本上是固定格式，用复制粘贴也可以，但几个表格每次都要复制粘贴太浪费时间了，请老师帮帮忙！谢谢啦
阅读权限20
在线时间 小时
& & & & & & & &
这是要做的表格
19:38 上传
点击文件名下载附件
713.5 KB, 下载次数: 26
阅读权限95
在线时间 小时
Sub Opiona() '//函数实例
Set SH1 = Worksheets(&北美BM标准&)
Set SH2 = Worksheets(&北美BM底搞&)
FileArr = FileAllArr(ThisWorkbook.Path, &*.xls&, ThisWorkbook.Name, True, False)
For Each SH In Worksheets
& & If SH.Name && SH1.Name And SH.Name && SH2.Name Then
& && &&&For i = 0 To UBound(FileArr)
& && && && &If GetPathFromFileName(FileArr(i)) = SH.Name Then
& && && && && & SH.Range(&A1:AZ65536&).ClearContents
& && && && && & Set WB = GetObject(FileArr(i))
& && && && && & Set SHX = WB.Sheets(1)
& && && && && & SHX.Cells.Copy SH.Range(&A1&)
& && && && && & WB.Close True&&'//保存
& && && && &End If
& && &&&Next
& & End If
Next SH复制代码
阅读权限95
在线时间 小时
(1004.43 KB, 下载次数: 111)
21:41 上传
点击文件名下载附件
阅读权限20
在线时间 小时
非常感谢四楼，我的意思是要把导出数据下面的六个表里的全部数据分别复制到APS表里面的各个同名表里，比如外协的数据复制到外协数据里
最新热点 /1
双11淘书大会战，ExcelHome图书当当网5折封顶，京东满200-100，机不可失！
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师查看: 6495|回复: 21
如何将所有其他工作表中的数据自动复制到一个工作表中
阅读权限10
在线时间 小时
请阅附件，如将SHEET3中及SHEET2中手工输入的数据自动复制到SHEET1中，按日期自动排序
18:12 上传
点击文件名下载附件
1.5 KB, 下载次数: 84
阅读权限95
在线时间 小时
这样可以不？
(9.91 KB, 下载次数: 200)
20:18 上传
点击文件名下载附件
阅读权限70
在线时间 小时
你的文件感染了StartUp.xls宏病毒。
提醒：近来在论坛上感染StartUp.xls宏病毒。
阅读权限70
在线时间 小时
&&HH1 = Sheets(&sheet1&).Range(&A65536&).End(xlUp).Row& & '获取最后一行
&&Sheets(&sheet1&).Rows(&1:& & HH1).Delete&&'删除所有行
&&HH2 = Sheets(&sheet2&).Range(&A65536&).End(xlUp).Row& & '获取最后一行
&&Sheets(&sheet2&).Range(&A1:D& & HH2).Copy Sheets(&sheet1&).Range(&A1&)
&&HH1 = Sheets(&sheet1&).Range(&A65536&).End(xlUp).Row& & '获取最后一行
&&HH3 = Sheets(&sheet3&).Range(&A65536&).End(xlUp).Row& & '获取最后一行
&&Sheets(&sheet3&).Range(&A1:D& & HH3).Copy Sheets(&sheet1&).Range(&A& & HH1 + 1)
阅读权限20
在线时间 小时
前几天感染了病毒害的同事们都骂我，幸好现在处理好了
阅读权限95
在线时间 小时
guzhen9315 发表于
你的文件感染了StartUp.xls宏病毒。
提醒：近来在论坛上感染StartUp.xls宏病毒。
检查1楼、2楼附件没有发现StartUp.xls宏病毒，估计是你的电脑中该病毒了，请查一下
阅读权限70
在线时间 小时
zhaogang1960 发表于
检查1楼、2楼附件没有发现StartUp.xls宏病毒，估计是你的电脑中该病毒了，请查一下
好的，谢谢！
我已经删除了。
新年快乐！
阅读权限10
在线时间 小时
& & & & & & & &
guzhen9315 ，谢谢你，真不错哈，能不能更改一下，SHEET1的第一行字段我要固定，从第二行开始复制过来，另外如果有10个表格的话，该如何处理。
阅读权限10
在线时间 小时
guzhen9315 发表于
&&HH1 = Sheets(&sheet1&).Range(&A65536&).End(xlUp).Row& & '获取最后一行
&&Sheets(&sheet1 ...
guzhen9315 ，谢谢你，真不错哈，能不能更改一下，SHEET1的第一行字段我要固定，从第二行开始复制过来，另外如果有10个表格的话，该如何处理
阅读权限70
在线时间 小时
lhdcxz 发表于
这样可以不？
楼主看贴不仔细呀，2楼不是给你了吗。
Private Sub CommandButton1_Click()
& & Dim sht As Worksheet
& & Application.ScreenUpdating = False
& & X = Range(&A65536&).End(xlUp).Row + 1
& & Range(&A2:D& & X).Clear
& & For Each sht In Worksheets
& && &&&If sht.Name && ActiveSheet.Name Then
& && && && &X = Range(&A65536&).End(xlUp).Row + 1
& && && && &Sheets(sht.Name).UsedRange.Copy Cells(X, 1)
& && &&&End If
& & X = Range(&A65536&).End(xlUp).Row
& & Range(&A1:D& & X).Sort Key1:=Range(&A2&), _
& && && && && && && && & Order1:=xlAscending, _
& && && && && && && && & Header:=xlGuess, _
& && && && && && &&&OrderCustom:=1, _
& && && && && && && & MatchCase:=False, _
& && && && && && &&&Orientation:=xlTopToBottom, _
& && && && && && && &SortMethod:=xlPinYin, _
& && && && && && &&&DataOption1:=xlSortNormal
& & Range(&A1&).Select
& & Application.ScreenUpdating = True
最新热点 /1
双11淘书大会战，ExcelHome图书当当网5折封顶，京东满200-100，机不可失！
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师如何使用VBA实现将多个Excel文件中的数据复制到某个Excel文件中 - CSDN博客
如何使用VBA实现将多个Excel文件中的数据复制到某个Excel文件中
最近做了一个小的Demo，实现了将各个销售的Excel台帐数据自动复制到主管的台帐Excel中，主要代码如下：
-------------------------------------------------------------
Sub CopyFromSubFiles()
& & Dim MyFile As String
& & Dim Arr(1000) As String '最多处理1000个子台帐
& & Dim count As Integer
& & Dim CurrentPath As String
& & Dim MyWorkbook As Workbook & & &'父台帐
& & Dim Targetkbook As Workbook & & '子台帐
& & Dim StartLine1 As Integer
& & Dim StartLine2 As Integer
& & CurrentPath = ThisWorkbook.Path & &\temp\&
& & MyFile = Dir(CurrentPath & &*.*&)
& & count = count + 1
& & Arr(count) = MyFile
& & Do While MyFile && &&
& & & & MyFile = Dir
& & & & If MyFile = && Then
& & & & & & Exit Do
& & & & End If
& & & & count = count + 1
& & & & Arr(count) = MyFile & & & & '将文件的名字存在数组中
& & '没有子台帐
& & If count &= 0 Then
& & & & Exit Sub
& & End If
& & '在父台帐中新建一个工作表
& & Worksheets.Add After:=Worksheets(Worksheets.count)
& & Sheets(1).Select
& & Sheets(1).Rows(&1:2&).Select
& & Selection.Copy
& & Sheets(Worksheets.count).Select
& & Sheets(Worksheets.count).Rows(&1:1&).Select
& & 'Application.CutCopyMode = False & & & & '关闭剪贴板提示信息
& & ActiveSheet.Paste
& & Dim n As Integer
& & n = BaseLine
& & StartLine1 = n & & &'父台帐开始复制的起始行&&
& & '打开每个子台帐，将信息复制到父台帐
& & For i = 1 To count& & & &&
& & & & Workbooks.Open Filename:=CurrentPath & Arr(i) &'循环打开Excel文件
& & & & Sheets(1).Select
& & & & n = BaseLine
& & & & '从第三行开始寻找子台帐信息的结束行
& & & & With Sheets(1)
& & & & & & Do While .Cells(n, 1).Text && &&
& & & & & & & & n = n + 1
& & & & & & Loop
& & & & End With
& & & & StartLine2 = n - 1 & &'子台帐复制的结束行
& & & & '从起始行开始复制
& & & & Sheets(1).Rows(BaseLine & &:& & StartLine2).Select
& & & & Selection.Copy
& & & & ThisWorkbook.Activate
& & & & Sheets(Worksheets.count).Select
& & & & Sheets(Worksheets.count).Rows(StartLine1 & &:& & StartLine1).Select
& & & & ActiveSheet.Paste
& & & & StartLine1 = StartLine1 + StartLine2 - BaseLine &'父台帐复制起始行向下移& & & &&
& & & & Application.CutCopyMode = False & & & & '关闭剪贴板提示信息
& & & & Workbooks(Arr(i)).Close savechanges = False & & '关闭子台帐
& & 'ActiveWorkbook.Close savechanges = False & & '关闭打开的文件
& & ThisWorkbook.Activate
& & Sheets(Worksheets.count).Select
& & ActiveSheet.Range(&A:AA&).EntireColumn.AutoFit
& & ActiveSheet.Range(&A1&).Select
& & 'Cells.EntireColumn.AutoFit
& & Application.CutCopyMode = True
----------------------------------------------------------------
相关的链接：
Excel VBA - 遍历某个文件夹中文件、文件夹及批量建立txt
http://blog.csdn.net/alexbnlee/article/details/6932339
VBA如何获取当前EXCEL文件的路径
.cn/s/blog_611fx7.html
本文已收录于以下专栏：
相关文章推荐
我们项目管理有两个工作薄，一个里面有多个表，每天建一个，记录当天项目，另一个工作薄，有多个表，其中一个是所有项目汇总。
以前都是第一个工作薄一个表做完，再复制粘贴到第二个工作薄的汇总表中。
Dim xlApp2
Dim xlBook
Dim xlBook2
Dim xlSheet
Dim xlSheet2
Dim getPath
Dim savePath...
自动复制数据
Sub CopyData()
hh = MsgBox(&Confirm to refresh?&, vbOKCancel, &Confirm&)
临时用到VBA，做一个需求：把不在同一个文件中的数据复制到一个文件中。
新建过程，如下：
Sub 复制行()
Dim mybook As Workbook
Set myboo...
给定A, B两个整数，不使用除法和取模运算，求A/B的商和余数。
1．   最基本的算法是，从小到大遍历：
for (i = 2 to A -1)
         if (i * B &...
K-means聚类算法是一种非层次聚类算法，在最小误差的基础上将数据划分了特定的类，类间利用距离作为相似度指标，两个向量之间的距离越小，其相似度就越高。程序读取全国省市经纬度坐标，然后根据经纬度坐标进...
本人最近在研究Radon变换，在查阅了各种资料之后在此写下个人的理解，希望与各位牛牛进行交流共同进步，也使得理解更加深刻些。
Radon变换的本质是将原来的函数做了一个空间转换，即，将原来的XY平...
Matlab绘图强大的绘图功能是Matlab的特点之一，Matlab提供了一系列的绘图函数，用户不需要过多的考虑绘图的细节，只需要给出一些基本参数就能得到所需图形，这类函数称为高层绘图函数。此外，Ma...
由于csdn贴图不方便，并且不能上传附件，我把原文上传到了资源空间CT图像重建技术
计算机层析成像(Computed Tomography，CT)是通过对物体进行不同角度的射线投影测量而...
他的最新文章
讲师：王禹华
讲师：宋宝华
您举报文章：
举报原因：
原文地址：
原因补充：
(最多只允许输入30个字)