Страницы: 1
RSS
Скопировать значение из одной книги в другую "по-тихому"
 

Как скопировать значение из одной книгу в другую, но так, чтобы фокус не переходил на книгу в которую копируются значения? То есть, чтобы значение скопировалось "по-тихому". Мой код копирует значение, но сделать "тихое" копирование не получилось. Код макроса изначально записан в личную книгу макросов, чтобы его можно было запускать в любом экзелевском файле. Помогите пожалуйста.

Код
'Отключаем перерисовку для ускорения работы макроса
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False
    Application.DisplayStatusBar = False
    Application.DisplayAlerts = False

' Копируем активную ячейку
    ActiveCell.Copy
    
    Workbooks("Уникальные адреса.xlsx").Activate
    Sheets("Уникальные адреса").Activate
       
    Dim mia
    ' Определяем первую пустую строку в столбце В, чтобы в неё вставить копируемое значение
    mia = Cells(Rows.Count, 2).End(xlUp).Row + 1
    Cells(mia, 2).Activate
    ' Вставляем значение
    ActiveSheet.Paste
 
В общем нашёл решение. Надо было активной книге переменную задать. Вот рабочий код.
Код
'Отключаем перерисовку для ускорения работы макроса
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False
    Application.DisplayStatusBar = False
    Application.DisplayAlerts = False
    
    sia = ActiveWorkbook.Name

    ' Копируем активную ячейку
    ActiveCell.Copy
    
    Workbooks("Уникальные адреса.xlsx").Activate
    Sheets("Уникальные адреса").Activate
    
         
    Dim mia

    ' Определяем первую пустую строку в столбце В, чтобы в неё вставить копируемое значение
    mia = Cells(Rows.Count, 2).End(xlUp).Row + 1
   
    Cells(mia, 2).Activate
    ' Вставляем значение
    ActiveSheet.Paste
    
    Workbooks(sia).Activate
    Sheets("Лист1").Activate
    
    'Включаем прорисовку
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    ActiveSheet.DisplayPageBreaks = True
    Application.DisplayStatusBar = True
    Application.DisplayAlerts = True
Изменено: Amert - 14.03.2018 10:50:13 (Съехало форматирование)
 
Цитата
Amert написал:
Как скопировать значение из одной книгу в другую, но так, чтобы фокус не переходил на книгу в которую копируются значения?
не активируйте новую книгу и листы на ней…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Используйте
Код
With 
'код....
End With
"Все гениальное просто, а все простое гениально!!!"
 
Цитата
Jack Famous написал:
не активируйте новую книгу и листы на ней…
А как тогда мне вставить копируемое значение в другую книгу без активации оной?  
 
Nordheim, спасибо за совет. Код стал выглядеть легче.
 
Цитата
Amert написал:
как ..вставить копируемое значение в другую книгу без активации оной
вариант от Nordheim, это он и был. :)
 
V, Что-то я в упор не пойму как мне переделать свой код по такому способу. Можете наглядно показать?  
 
Вместо:
Код
sia = ActiveWorkbook.Name 
    ' Копируем активную ячейку
    ActiveCell.Copy
     
    Workbooks("Уникальные адреса.xlsx").Activate
    Sheets("Уникальные адреса").Activate
     
          
    Dim mia
 
    ' Определяем первую пустую строку в столбце В, чтобы в неё вставить копируемое значение
    mia = Cells(Rows.Count, 2).End(xlUp).Row + 1
    
    Cells(mia, 2).Activate
    ' Вставляем значение
    ActiveSheet.Paste
     
    Workbooks(sia).Activate
    Sheets("Лист1").Activate
пишите:
Код
Dim mia
    with Workbooks("Уникальные адреса.xlsx").Sheets("Уникальные адреса")
     ' Определяем первую пустую строку в столбце В, чтобы в неё вставить копируемое значение
     mia = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
     ' Копируем активную ячейку
     ActiveCell.Copy .Cells(mia, 2)
    end with

но можно и без переменной:
Код
    with Workbooks("Уникальные адреса.xlsx").Sheets("Уникальные адреса")
     ' Копируем активную ячейку
     ActiveCell.Copy .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row + 1, 2)
    end with
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Код
Dim mia
sia = ActiveWorkbook.Name
With Workbooks("Уникальные адреса.xlsx").Sheets("Уникальные адреса")
    mia = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
    sia.ActiveCell.Copy .Cells(mia, 2)
End With
"Все гениальное просто, а все простое гениально!!!"
 
Дмитрий Щербаков,Спасибо! Попробую теперь этот метод на другие свои макросы перенести.
 
Nordheim, по-моему, будет ошибка тут:
sia = ActiveWorkbook.Name
With Workbooks("Уникальные адреса.xlsx").Sheets("Уникальные адреса")
   mia = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
   sia.ActiveCell.Copy .Cells(mia, 2)
End With
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий Щербаков, всё работает так как мне и было нужно. Значения копируются в первую пустую строчку столбца В и фокус не переходит на книгу "Уникальные адреса.xlsx".
Код
'Отключаем перерисовку для ускорения работы макроса
With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
.DisplayAlerts = False
.DisplayStatusBar = False

End With
ActiveSheet.DisplayPageBreaks = False
  
   
    With Workbooks("Уникальные адреса.xlsx").Sheets("Уникальные адреса")
     ' Копируем активную ячейку
     ActiveCell.Copy .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row + 1, 2)
    End With
           
     
'Включаем прорисовку
With Application
    
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.DisplayAlerts = True
.DisplayStatusBar = True
    
End With
ActiveSheet.DisplayPageBreaks = True
Изменено: Amert - 14.03.2018 12:42:05 (Съехало форматирование)
 
Цитата
Дмитрий Щербаков написал:
Nordheim , по-моему, будет ошибка тут:sia = ActiveWorkbook.NameWith Workbooks("Уникальные адреса.xlsx").Sheets("Уникальные адреса")    mia = .Cells(.Rows.Count, 2).End(xlUp).Row + 1    sia.ActiveCell.Copy .Cells(mia, 2)End With
Дмитрий Спасибо, не заметил что переменной присваивается имя а не объект.
"Все гениальное просто, а все простое гениально!!!"
Страницы: 1
Наверх