Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Возможность переноса данных на другой лист (файл) - Мир MS Excel

  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Возможность переноса данных на другой лист (файл)
Schag Дата: Суббота, 27.06.2015, 18:20 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 26
Репутация: 1 ±
Замечаний: 0% ±

Excel 2013
Возник такой вопрос. Существет таблица данные в которую вкладка 1 (столбцы B и C) собираются из разных источников (гиперссылки) в реальном времени, вся таблица столбцов 20. Соответственно при открытии файла происходит обновление данных в этих столбиках на текущие. Возможно ли сделать так что бы данные столбцов B,C,D автоматически копировались в отдельную вкладку 2 (например 1 раз в день) в сводную таблицу по дням?
К сообщению приложен файл: 0070663.xlsx (14.4 Kb)
 
Ответить
СообщениеВозник такой вопрос. Существет таблица данные в которую вкладка 1 (столбцы B и C) собираются из разных источников (гиперссылки) в реальном времени, вся таблица столбцов 20. Соответственно при открытии файла происходит обновление данных в этих столбиках на текущие. Возможно ли сделать так что бы данные столбцов B,C,D автоматически копировались в отдельную вкладку 2 (например 1 раз в день) в сводную таблицу по дням?

Автор - Schag
Дата добавления - 27.06.2015 в 18:20
МВТ Дата: Суббота, 27.06.2015, 20:06 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 476
Репутация: 137 ±
Замечаний: 0% ±

Excel 2007
Вот такой макрос получился (запускать можно вручную или по 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]


Сообщение отредактировал МВТ - Суббота, 27.06.2015, 20:07
 
Ответить
СообщениеВот такой макрос получился (запускать можно вручную или по 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]

Автор - МВТ
Дата добавления - 27.06.2015 в 20:06
Schag Дата: Суббота, 27.06.2015, 22:28 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 26
Репутация: 1 ±
Замечаний: 0% ±

Excel 2013
Вот такой макрос получился (запускать можно вручную или по Application.OnTime)
Извиняюсь. Можно поподробнее, с примером. Не могу вставить, при применении пишет ошибку. :( :( :(
Туго у меня с макросами.


Сообщение отредактировал Schag - Суббота, 27.06.2015, 22:28
 
Ответить
СообщениеВот такой макрос получился (запускать можно вручную или по Application.OnTime)
Извиняюсь. Можно поподробнее, с примером. Не могу вставить, при применении пишет ошибку. :( :( :(
Туго у меня с макросами.

Автор - Schag
Дата добавления - 27.06.2015 в 22:28
МВТ Дата: Воскресенье, 28.06.2015, 21:15 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 476
Репутация: 137 ±
Замечаний: 0% ±

Excel 2007
Нажимаете кнопку и все :)
К сообщению приложен файл: 0070663.xlsm (25.2 Kb)
 
Ответить
СообщениеНажимаете кнопку и все :)

Автор - МВТ
Дата добавления - 28.06.2015 в 21:15
ShAM Дата: Понедельник, 29.06.2015, 02:50 | Сообщение № 5
Группа: Друзья
Ранг: Старожил
Сообщений: 1347
Репутация: 249 ±
Замечаний: 0% ±

Excel 2010
Ругается: "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]
К сообщению приложен файл: 0070663_1.xlsm (25.0 Kb)
 
Ответить
СообщениеРугается: "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]

Автор - ShAM
Дата добавления - 29.06.2015 в 02:50
Schag Дата: Понедельник, 29.06.2015, 11:38 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 26
Репутация: 1 ±
Замечаний: 0% ±

Excel 2013
Спасибо всем. Заработал последний вариант. Всем + к репутации :D :D :D
 
Ответить
СообщениеСпасибо всем. Заработал последний вариант. Всем + к репутации :D :D :D

Автор - Schag
Дата добавления - 29.06.2015 в 11:38
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2025 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!