Excel VBA宏上的方法粘贴特殊

我正在使用一个宏来连接来自同一目录中不同Excel文件的行 以下是当前版本：

Sub Compilationb()
Dim Temp As String
Dim Lignea As Long
Temp = Dir(ActiveWorkbook.Path & "\*.xls")
Application.DisplayAlerts = False
Workbooks("RecapB.xls").Sheets(1).Range("A2:Z60000").ClearContents

Do While Temp <> ""
   If Temp <> "RecapB.xls" Then
      Workbooks.Open ActiveWorkbook.Path & "\" & Tempa
      Workbooks(Tempa).Sheets(1).Range("A4").CurrentRegion.Copy
      Workbooks("RecapB.xls").Sheets(1).Activate
      Lignea = Sheets(1).Range("A65536").End(xlUp).Row + 1
      Range("A" & CStr(Lignea)).Select
      ActiveSheet.Paste
      Workbooks(Temp).Close
   End If
Temp = Dir
Loop

Range("A4").Select
Application.DisplayAlerts = True

End Sub 

到

但它不起作用。显然，方法“PasteSpecial”对对象“Activesheet”不起作用。有人知道我如何强制它复制值吗

---

提前感谢

您需要的是

范围。粘贴特殊

，而不是

工作表。粘贴特殊

：

ActiveCell.PasteSpecial xlPasteValues

---

另外，避免

select

ing范围。这几乎是不需要的。您的例行程序可以写成：

Sub Compilationb()
  Dim Temp As String
  Dim target_sheet As Worksheet

  Application.DisplayAlerts = False

  Set target_sheet = Workbooks("RecapB.xls").Sheets(1)
  target_sheet.Range("A2:Z60000").ClearContents

  Temp = Dir(ActiveWorkbook.Path & "\*.xls")
  Do While Len(Temp) > 0
    If Temp <> "RecapB.xls" Then
      Dim current_book As Workbook
      Set current_book = Workbooks.Open(ActiveWorkbook.Path & "\" & Temp)

      Dim target_range As Range
      Set target_range = target_sheet.Cells(target_sheet.Rows.Count, 1).End(xlUp).Offset(1, 0)

      current_book.Sheets(1).Range("A4").CurrentRegion.Copy
      target_range.PasteSpecial xlPasteValues

      Application.CutCopyMode = False

      current_book.Close SaveChanges:=False
    End If
    Temp = Dir
  Loop

  Range("A4").Select
  Application.DisplayAlerts = True

End Sub

子编译b（）
作为字符串的Dim Temp
将目标工作表变暗为工作表
Application.DisplayAlerts=False
设置目标工作表=工作簿（“RecapB.xls”）。工作表（1）
目标表范围（“A2:Z60000”）.ClearContent
Temp=Dir（ActiveWorkbook.Path&“\*.xls”）
当Len（Temp）>0时执行
如果温度为“RecapB.xls”，则
将当前工作簿设置为工作簿
设置当前\u book=Workbooks.Open（ActiveWorkbook.Path&“\”&Temp）
变暗目标范围作为范围
设置target_range=target_sheet.Cells（target_sheet.Rows.Count，1）。End（xlUp）。Offset（1，0）
当前书籍页（1）.范围（“A4”）.当前区域.Copy
target_range.paste特殊XLPaste值
Application.CutCopyMode=False
当前_book.Close SaveChanges:=False
如果结束
Temp=Dir
环
范围（“A4”）。选择
Application.DisplayAlerts=True
端接头

ActiveCell.PasteSpecial xlPasteValues

Sub Compilationb()
  Dim Temp As String
  Dim target_sheet As Worksheet

  Application.DisplayAlerts = False

  Set target_sheet = Workbooks("RecapB.xls").Sheets(1)
  target_sheet.Range("A2:Z60000").ClearContents

  Temp = Dir(ActiveWorkbook.Path & "\*.xls")
  Do While Len(Temp) > 0
    If Temp <> "RecapB.xls" Then
      Dim current_book As Workbook
      Set current_book = Workbooks.Open(ActiveWorkbook.Path & "\" & Temp)

      Dim target_range As Range
      Set target_range = target_sheet.Cells(target_sheet.Rows.Count, 1).End(xlUp).Offset(1, 0)

      current_book.Sheets(1).Range("A4").CurrentRegion.Copy
      target_range.PasteSpecial xlPasteValues

      Application.CutCopyMode = False

      current_book.Close SaveChanges:=False
    End If
    Temp = Dir
  Loop

  Range("A4").Select
  Application.DisplayAlerts = True

End Sub