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 

Its работает просто отлично. Но макрокопия копирует формулы. И я хочу, чтобы он скопировал значения. Так я попытался изменить линию

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