|
楼主 |
发表于 2011-11-4 20:49
|
显示全部楼层
Workbooks.Open ThisWorkbook.Path & "\粘贴.xls"
Cells(1).Select
Dim x As Integer
'打开溶洞日报表
' 激活123.xls
Workbooks("123.xls").Activate
Cells(1).Select
For x = 1 To 127
Workbooks.Open ThisWorkbook.Path & "\" & ActiveCell.Value
'复制
Cells.Find(What:="33-11#桩", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate
ActiveCell.EntireRow.Select
Selection.Copy
'粘贴
Workbooks("粘贴.xls").Activate
ActiveCell.EntireRow.Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
'激活123下一单元格
Workbooks("123.xls").Activate
ActiveCell.Offset(1, 0).Select
'关闭日报文件
Workbooks(3).Activate
Application.CutCopyMode = False
Workbooks(3).Close (ture)
Next
End Sub
|
|