选择最后一个条目并偏移 1 行，然后粘贴值不起作用答案

【问题标题】：Select last entry and offset by 1 row then paste value not working选择最后一个条目并偏移 1 行，然后粘贴值不起作用
【发布时间】：2017-12-07 07:32:53
【问题描述】：

我在这段代码中遇到运行时错误 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的数据。
复制后会激活此代码所在的工作簿
从 E 列中选择最后一个条目
偏移 1 行
将选择粘贴到列激活的单元格

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

【问题讨论】：

标签： excel copy-paste offset vba

【解决方案1】：

首先，正如@teylyn 所建议的那样，您应该避免使用Select 和Activate（99.9% 的情况下它们是不需要的，而它们唯一做的“贡献”就是浪费时间，因为运行代码需要更长的时间）。

其次，您还应该指定要在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

【讨论】：

第三，使用xlUp而不是xlDown。（我很确定这是错误的根源，您在代码中自动修复了它，但忘记将其作为可能的原因提及。）
您的代码运行良好，但在第三个文件操作后遇到错误，带有 pastevalue 代码。我想出了 rng1 = Range("B15:E81") 来替换我使用@teylyn 建议的帖子进行复制的方式。但是如何粘贴到 E 列的下一个空单元格中？
@Tyler 在找到更新的LastRow 之后，@Tyler 行LastRow 是您粘贴到下一个空行的方式。我认为错误可能来自代码中的另一个地方。请分享您代码的其他相关部分。
dropbox.com/s/xy3wtbcc4fjf1d8/LoopExcel.bas?dl=0 您可以从上面的链接访问该模块。我将 rng1 添加到 .Range("E" & LastRow + 1) = rng1 并且没有任何反应。无论如何，您都可以检查我从模块本身所做的编辑
@Tyler 我无法从当前 PC 访问 Dropbox，抱歉

【解决方案2】：

您的代码 sn-p 对我来说运行没有错误。不过，您可能需要重新考虑这种方法。使用 Activate 和 Select 的代码既慢又低效。在大多数情况下，不需要激活和选择。可以直接寻址对象。

请参阅this question 了解避免选择和激活的技术。

【讨论】：