Question

我正在处理一个宏来连接来自不同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

它工作得很好。但宏复制公式。我希望它能够复制值。所以我试着改变这条线

ActiveSheet.Paste

到

ActiveSheet.PasteSpecial xlPasteValues

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

提前致谢

Answer 1

您需要Range.PasteSpecial，而不是Worksheet.PasteSpecial：

ActiveCell.PasteSpecial xlPasteValues

另外，请避免select范围。它几乎从不需要。您的例程可以写成：

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

关于PasteSpecial方法的Excel VBA宏

1 个答案: