Возник такой вопрос. Существет таблица данные в которую вкладка 1 (столбцы B и C) собираются из разных источников (гиперссылки) в реальном времени, вся таблица столбцов 20. Соответственно при открытии файла происходит обновление данных в этих столбиках на текущие. Возможно ли сделать так что бы данные столбцов B,C,D автоматически копировались в отдельную вкладку 2 (например 1 раз в день) в сводную таблицу по дням?
Возник такой вопрос. Существет таблица данные в которую вкладка 1 (столбцы B и C) собираются из разных источников (гиперссылки) в реальном времени, вся таблица столбцов 20. Соответственно при открытии файла происходит обновление данных в этих столбиках на текущие. Возможно ли сделать так что бы данные столбцов B,C,D автоматически копировались в отдельную вкладку 2 (например 1 раз в день) в сводную таблицу по дням?Schag
Вот такой макрос получился (запускать можно вручную или по Application.OnTime) [vba]
Код
Option Explicit Sub Rezerv() Dim L As Long Dim D As Date D = Date With Sheets("вкладка 2") L = .Cells(4, Columns.Count).End(xlToLeft).Column If .Cells(2, L - 3) = D Then Exit Sub Worksheets("вкладка 1").Range("A3:D18").Copy 'Dastination:=.Range(Cells(3, L + 1), Cells(18, L + 4)) .Range(Cells(3, L + 1), Cells(18, L + 4)).PasteSpecial xlPasteValues .Range(Cells(3, L + 1), Cells(18, L + 4)).PasteSpecial xlPasteFormats .Range(Cells(2, L + 1), Cells(2, L + 4)).Merge .Cells(3, L + 1).Copy .Cells(2, L + 1).PasteSpecial xlPasteFormats .Range(Cells(2, L + 1), Cells(2, L + 4)).Merge .Cells(2, L + 1) = D End With End Sub
End With End Sub
[/vba]
Вот такой макрос получился (запускать можно вручную или по Application.OnTime) [vba]
Код
Option Explicit Sub Rezerv() Dim L As Long Dim D As Date D = Date With Sheets("вкладка 2") L = .Cells(4, Columns.Count).End(xlToLeft).Column If .Cells(2, L - 3) = D Then Exit Sub Worksheets("вкладка 1").Range("A3:D18").Copy 'Dastination:=.Range(Cells(3, L + 1), Cells(18, L + 4)) .Range(Cells(3, L + 1), Cells(18, L + 4)).PasteSpecial xlPasteValues .Range(Cells(3, L + 1), Cells(18, L + 4)).PasteSpecial xlPasteFormats .Range(Cells(2, L + 1), Cells(2, L + 4)).Merge .Cells(3, L + 1).Copy .Cells(2, L + 1).PasteSpecial xlPasteFormats .Range(Cells(2, L + 1), Cells(2, L + 4)).Merge .Cells(2, L + 1) = D End With End Sub
Вот такой макрос получился (запускать можно вручную или по Application.OnTime) Извиняюсь. Можно поподробнее, с примером. Не могу вставить, при применении пишет ошибку. :( Туго у меня с макросами.
Вот такой макрос получился (запускать можно вручную или по Application.OnTime) Извиняюсь. Можно поподробнее, с примером. Не могу вставить, при применении пишет ошибку. :( Туго у меня с макросами.Schag
Сообщение отредактировал Schag - Суббота, 27.06.2015, 22:28
Ругается: "Application-defined or object-defined error" на эту строку:[vba]
Код
.Range(Cells(3, L + 1), Cells(18, L + 4)).PasteSpecial xlPasteValues
[/vba] Заработало вот так: [vba]
Код
Option Explicit Sub Rezerv() Dim L As Long Dim D As Date D = Date With Sheets("вкладка 2") L = .Cells(4, Columns.Count).End(xlToLeft).Column If .Cells(2, L - 3) = D Then Exit Sub Application.ScreenUpdating = False Worksheets("вкладка 1").Range("A3:D18").Copy 'Dastination:=.Range(Cells(3, L + 1), Cells(18, L + 4)) .Cells(3, L + 1).PasteSpecial xlPasteValues .Cells(3, L + 1).PasteSpecial xlPasteFormats .Cells(2, L + 1).Resize(, 4).Merge .Cells(3, L + 1).Copy .Cells(2, L + 1).PasteSpecial xlPasteFormats .Cells(2, L + 1).Resize(, 4).Merge .Cells(2, L + 1) = D Application.ScreenUpdating = True End With End Sub
[/vba]
Ругается: "Application-defined or object-defined error" на эту строку:[vba]
Код
.Range(Cells(3, L + 1), Cells(18, L + 4)).PasteSpecial xlPasteValues
[/vba] Заработало вот так: [vba]
Код
Option Explicit Sub Rezerv() Dim L As Long Dim D As Date D = Date With Sheets("вкладка 2") L = .Cells(4, Columns.Count).End(xlToLeft).Column If .Cells(2, L - 3) = D Then Exit Sub Application.ScreenUpdating = False Worksheets("вкладка 1").Range("A3:D18").Copy 'Dastination:=.Range(Cells(3, L + 1), Cells(18, L + 4)) .Cells(3, L + 1).PasteSpecial xlPasteValues .Cells(3, L + 1).PasteSpecial xlPasteFormats .Cells(2, L + 1).Resize(, 4).Merge .Cells(3, L + 1).Copy .Cells(2, L + 1).PasteSpecial xlPasteFormats .Cells(2, L + 1).Resize(, 4).Merge .Cells(2, L + 1) = D Application.ScreenUpdating = True End With End Sub