Страницы: 1
RSS
Копирование значения а не формул, макрос копирует формулу, а необходимо значение
 
Доброе утро друзья! помогите пожалуйста разобраться с макросом (взял его на одной из веток) штука хорошая, но мне нужно что бы она копировала не формулы из ячеек а значения, моих мозгов на это не хватит никогда, и вся надежда на Ваши Светлые головы!!!
Код
Option Explicit

Sub CollectAllClients()
Dim BazaWb As Workbook 'текущая книга (общий файл)
Dim BazaSht As Worksheet 'лист База покупателей в общем файле
Dim iTempFileName As String 'имя по-очерёдно открываемого файла
Dim iPath As String 'путь к папке, где лежат все файлы
Dim iLastRowBaza As Long 'последняя заполненная строка в общем файле в столбце A
Dim iLastRowTempWb As Long 'последняя заполненная строка в по-очерёдно открываемом файле в столбце A
Dim iNumFiles As Long 'количество открываемых файлов

    With Application 'операции с приложением/отключаем для повышения скорости работы макроса
        .ScreenUpdating = False 'обновление экрана
        .DisplayAlerts = False 'выод системных сообщений
        .Calculation = xlManual 'автопересчет формул
        
        'присваиваем значения нашим переменным
        Set BazaWb = ThisWorkbook
        Set BazaSht = BazaWb.Sheets("данные")
        iPath = BazaWb.Path & "\"
        iTempFileName = Dir(iPath & "*.xlsm")
        Do While iTempFileName <> "" 'запускае цикл перебора файдов в папке
            If iTempFileName <> BazaWb.Name Then 'если имя файла не равно общему открываем
                With .Workbooks.Open _
                     (Filename:=iPath & iTempFileName, UpdateLinks:=False, ReadOnly:=True)
                     iNumFiles = iNumFiles + 1
                     'Рабочая книга не должна быть защищена паролем
                     With .Worksheets("алфавит") 'с конкретным листом в открытой книге
                          'номер последней заполенной строки
                          iLastRowTempWb = .Cells(Rows.Count, 2).End(xlUp).Row
                          'последняя строка в итоговом файле на листе
                          iLastRowBaza = BazaSht.Cells(Rows.Count, 1).End(xlUp).Row + 1
                          'копируем диапазон с открытой книги в заданный лист
                          .Range("B11:Q175").Copy Destination:=BazaSht.Cells(iLastRowBaza, 1)
                     End With
                     .Close saveChanges:=False
                End With
            End If
            iTempFileName = Dir 'следующий файл
        Loop
        
        'включаем что отключили
        .Calculation = xlAutomatic
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    MsgBox "Информация собрана из " & iNumFiles & " файлов!", vbInformation, "Конец"
End Sub 
Изменено: Jystas - 20.12.2017 13:36:13
 
вместо
Код
Range("B11:Q175").Copy Destination:=BazaSht.Cells(iLastRowBaza, 1) 
пишите
Код
ar = [B11:Q175].value
BazaSht.Cells(iLastRowBaza, 1).resize(ubound(ar), ubound(ar,2)).value = ar
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, Compile error Variable not defined  :qstn:  
 
Код
Dim ar()
Согласие есть продукт при полном непротивлении сторон
 
обьявите, если не обьявлена
Код
dim ar:  ar = [B11:Q175].value
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, Приятно иметь дело с умными людьми!!
спасибо, я так с вашей помощью и шаманским бубном скоро стану ого го!!!
 
Jystas, спойлер можно и не использовать, а вот сам код форматируйте соответствующим тегом.
Страницы: 1
Наверх