Select 最后一个条目并偏移 1 行然后粘贴值不起作用

Question

我在使用此代码时遇到运行时间错误 1004。

Sub LoopAllExcelFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and     perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog




'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

With FldrPicker
  .Title = "Select A Target Folder"
  .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    myPath = .SelectedItems(1) & "\"
End With

   'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "*.xls*"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

    'Loop through each Excel file in folder
  Do While myFile <> ""
'Set variable equal to opened workbook
  Set wb = Workbooks.Open(Filename:=myPath & myFile)

'Ensure Workbook has opened before moving on to next line of code
  DoEvents

Dim LastRow As Long
Dim rng1 As Range
wb.Worksheets(1).Activate
Set rng1 = Range("B15:E81,N15:O81")

With ThisWorkbook.Worksheets("Sheet1") '<-- modify "Sheet1" to your sheet's name
LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row ' get last row with data in column "E"
' paste
.Range("E" & LastRow + 1) = rng1
End With

'Save and Close Workbook
  wb.Close SaveChanges:=True

'Ensure Workbook has closed before moving on to next line of code
  DoEvents

'Get next file name
  myFile = Dir
  Loop

'Message Box when tasks are completed
  MsgBox "Task Complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

我正在使用这段代码从文件夹中的所有 excel 工作簿中提取 B15 到 E81 的数据。
复制后，将激活此代码所在的工作簿
Select E 列的最后一个条目
偏移 1 行
将选择粘贴到列激活的单元格

感谢我能找到的所有帮助。提前致谢。

Answer 1

你的代码片段对我来说运行没有错误。不过，您可能需要重新考虑该方法。使用 Activate 和 Select 的代码速度慢且效率低下。在大多数情况下，不需要 Activate 和 Select。对象可以直接寻址。

请参阅 this question 了解避免 Select 和激活的技巧。

Answer 2

First，正如@teylyn 所建议的，您应该避免使用 Select 和 Activate（99.9% 的时间不需要它们，并且他们做的唯一一件事 "contribute" 就是浪费时间，因为代码需要更长的时间才能运行)。

第二个，您还应该指定要粘贴到 ThisWorkbook 对象中的哪个 Worksheet。

代码

Dim LastRow As Long

wb.Worksheets(1).Range("B15:E81").Copy

With ThisWorkbook.Worksheets("Sheet1") '<-- modify "Sheet1" to your sheet's name
    LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row ' get last row with data in column "E"

    ' paste
    .Range("E" & LastRow + 1).PasteSpecial Paste:=xlPasteValues
End With

Select 最后一个条目并偏移 1 行然后粘贴值不起作用

Select last entry and offset by 1 row then paste value not working

excel

vba

copy-paste

offset