Sub buildtimetable()
Dim FolderName As String
Dim Fname As String
FolderName = "C:\New folder\test"
If Right(FolderName, 1) <> Application.PathSeparator Then FolderName = FolderName & Application.PathSeparator
Fname = Dir(FolderName & "*.xls")
'loop through the files
Do While Len(Fname)
With Workbooks.Open(FolderName & Fname)
Dim w As Workbook
Dim lastrow As Long
lastrow = Range("A300000").End(xlUp).Row
ActiveWorkbook.Sheets(2).Select
Range("K2").Select
Selection.Copy
Workbooks("TimeTable.xlsx").Activate
Sheets(1).Rows(_
Sheets(1).Range("B" & Rows.Count).End(xlUp).Row + 1 & _
":" & _
Sheets(1).Range("B" & Rows.Count).End(xlUp).Row + 1 _
).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Workbooks(Fname).Activate
ActiveWorkbook.Sheets(3).Select
Range("K2").Select
Selection.Copy
Workbooks("TimeTable.xlsx").Activate
Sheets(1).Rows(_
Sheets(1).Range("C" & Rows.Count).End(xlUp).Row + 1 & _
":" & _
Sheets(1).Range("C" & Rows.Count).End(xlUp).Row + 1 _
).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End With
' go to the next file in the folder
Fname = Dir
Application.DisplayAlerts = False
Application.EnableEvents = False
ActiveWorkbook.Close
Loop
End Sub
我想在我的目錄中打開一個文件,並從細胞K2在表2和3複製值一個我已經在桌面上打開的新工作簿。這段代碼不起作用,我似乎無法弄清楚我錯在哪裏。通常在指定選擇/激活哪個工作簿時遇到困難。
恰好是不工作怎麼辦?你看到了什麼錯誤? – 2014-09-29 13:16:42
它不會將單元格值從K2複製到我的其他工作簿,而是從B2開始獲取相同編號的無盡行,並且一直持續到工作表的末尾。現在我試圖打開新的工作簿,粘貼,保存並關閉。然後重新打開舊的工作簿,轉到表3並重復。但這甚至聽起來非常低效,似乎根本不起作用。 – excelhelp 2014-09-29 15:05:56
我想如果你清理所有的Select和Activate語句,答案就會很清楚。您不需要選擇或激活工作簿/工作表/單元格以從中進行復制。只需使用完整的命令。例如:'Workbook.Worksheet.Range(...)。Copy' – 2014-09-29 15:23:37