Макрос Excel VBA по методу PasteSpecial

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