Question

关于excel vba编程的问题，有没有高手在啊。

我想用vba方式制作一个宏按钮来执行一项繁琐的重复复制粘贴的工作，它要求能自动根据我当前需要粘贴内容的工作薄1里面某一个单元格的内容（此内容就是需要打开复制的工作薄的名字）打开特定的工作薄2。然后再根据工作薄1里面某列里不同的名字在工作薄2里寻找到他对应的数据，复制，然后在工作薄1里面对应的位置粘贴。然后关闭工作薄2.接下来再继续在有工作薄名字的那一列根据下一个单元格（或者往下固定行数）的单元格里的内容再次打开新的工作薄3，重复刚才的工作，复制粘贴。一直到包含有工作薄名字的那一列最后。如能解决此问题，肯定加分。100以上。如需要上图我会补充问题的。
http://zhidao.baidu.com/question/1540912123289776867.html
上次我是想通过函数公式的的方式解决的。后来反复试验都是不行，才想到用宏命令来做。

下面这个表的路径是D:\详细\2004-05-11_机加.xls

下面这个表是要粘贴内容的表，A2就是工作薄1的名字

要求就是依次根据工作薄2的A列里2,10,18,26............这一系列单元格里的内容打开相应的工作薄，这些工作薄的路径都固定的在D:\详细\......xls
需要复制粘贴的数据都在C到H列。但行数不一样，需要粘贴的比较固定，但是需要复制的不固定，只能根据名字索引。而且有的工作薄名字不全，有的只有六个，有的只有五个。所以复制的语句都得是IF语句，真时复制，假时跳过，只把2里相应的单元格上色。就如上图王鑫那一行。一个小表做完，再根据第二个表头的单元格内容打开相应内容的工作薄。继续重复刚才的工作。一直到底，大概一个工作薄有几百个小表吧，粘贴时选择只粘贴数值，因为里面有公式。





Answer 1

宏代码如下
Sub 求和()
Dim mg As Range
Dim i As Long, k As Long, l As Long, m As Long
On Error Resume Next
Application.DisplayAlerts = False
k = 2 ' 单元格起始
l = 2 ' 单元格步长
i = 1
m = InputBox("求和的总行数", , 20)
Do While k <= m '当k>m时结束do
Do While Cells(l, 1) <> ""
l = l + 1 '当cells(l,1)不为空,l增加1,
Loop
If Cells(l - 1, 1) <> "" Then '当cells(l,1)=空 ,l-1 为空的单元格上边非空单元格的个数
Range(Cells(k, 1), Cells(l - 1, 1)).Select
Cells(l - 1, 2) = WorksheetFunction.Sum(Selection)
Cells(l - 1, 3) = Selection.Count
End If
k = l + 1
l = l + 1
Loop
End Sub

追问

大哥不是逗我吧，我就算乱打字这点时间都打不了这么多。
当真能完美解决我的问题那就太好了，不然我非残废了不可。
不过我看你开始就是求和好像跟我要求的不一样啊。

Answer 2

看来你不懂VBA了，楼上的代码一看就不能满足要求，你却不知道。
你要把问题具体化才行，不要用某列表示，具体说哪列是文件名，哪列是要找的数据，还有在工作簿2的哪个工作表（甚至哪列）找，找到后复制哪部分内容，具体怎样粘贴等等，不说清楚无法完成你的事情。

追问

谢谢你的回答，其实我只是想先问问这样一套动作从逻辑上能不能用vba完成，如果能完成我就上传图片吧具体的要求说出来，因为我没有多少财富值，上一次提出来个问题，结果没有人能解决，悬赏的财富值也不退，所以这次就是先看看有没有人能解决，如果能解决的话，是邮件也好，上传图片也好，总之最后我会把我四分之一的财富值悬赏的。

追答

这个对于VBA来说，还是比较简单的。
上次的提问我怎么没看见呢，标题中没有“VBA”这个关键字吗，发上次的提问页地址给我吧，也不让你的财富浪费掉

追问

先谢谢你了，我补充了问题，上了图。完美解决加分300

追答

双击 A1 单元格运行。

没明白王鑫为什么要上色，所以这部分代码没写。

追问

上色就是为了要醒目点，好好一下就能找到他，要不我在几千的数据中很容易忽略。还能改么，如果能改，把方法发给我吧，唯一的遗憾就是这个，其他都很好，非常感谢。加分300

追答

上色的代码加上了，详见附件。前一提问也有回答