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

Вход

Регистрация

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

 

= Мир MS Excel/Дублирование основной таблицы на другой лист (только знач) - Мир MS Excel

Старая форма входа
  • Страница 1 из 2
  • 1
  • 2
  • »
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Дублирование основной таблицы на другой лист (только знач) (Макросы/Sub)
Дублирование основной таблицы на другой лист (только знач)
anisimovaleksandr32 Дата: Пятница, 20.10.2023, 15:55 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 74
Репутация: 0 ±
Замечаний: 20% ±

Добрый день всем, многоуважаемые форумчане.
прошу вас подсказать/помочь: (файл прикладываю аналог не рабочий)
Имеется таблица с данными "основная" в которой происходит расчеты. Данную таблицу нужно скопировать/продублировать на второй лист
Произвел запись макроса:

После чего решил его прописать на основном листе (чтоб при каждом изменении на листе - происходило срабатывание данного макроса)

Но почему то теперь ругается.

Так еще и с возникнувшей проблемой - не могу посмотреть а если я удалю строки из таблицы или добавлю строки в таблицу (((( как быть.
Нашел при этом одну тему хорошую My WebPage в которой было решение через создание подключения.
В начале у меня все получилось (пришлось создать новый лист - туда вставить таблицу) но потом после наполнения информации на данный лист таблица начала сама изменять порядок столбцов ((((
А потом подумал - а вдруг будет установлен офис старый тогда он и вовсе не обновит связи ((((

Как быть!?
Подскажите пожалуйста
К сообщению приложен файл: tablicy.xlsm (50.5 Kb)


Сообщение отредактировал anisimovaleksandr32 - Пятница, 20.10.2023, 15:56
 
Ответить
СообщениеДобрый день всем, многоуважаемые форумчане.
прошу вас подсказать/помочь: (файл прикладываю аналог не рабочий)
Имеется таблица с данными "основная" в которой происходит расчеты. Данную таблицу нужно скопировать/продублировать на второй лист
Произвел запись макроса:

После чего решил его прописать на основном листе (чтоб при каждом изменении на листе - происходило срабатывание данного макроса)

Но почему то теперь ругается.

Так еще и с возникнувшей проблемой - не могу посмотреть а если я удалю строки из таблицы или добавлю строки в таблицу (((( как быть.
Нашел при этом одну тему хорошую My WebPage в которой было решение через создание подключения.
В начале у меня все получилось (пришлось создать новый лист - туда вставить таблицу) но потом после наполнения информации на данный лист таблица начала сама изменять порядок столбцов ((((
А потом подумал - а вдруг будет установлен офис старый тогда он и вовсе не обновит связи ((((

Как быть!?
Подскажите пожалуйста

Автор - anisimovaleksandr32
Дата добавления - 20.10.2023 в 15:55
MikeVol Дата: Пятница, 20.10.2023, 16:30 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 291
Репутация: 51 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
anisimovaleksandr32, Доброго времени суток. Если я вас правильно понял, то вот вам вариант. [vba]
Код
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tbl         As ListObject: Set tbl = ListObjects("Расчет")
    Dim ws          As Worksheet: Set ws = ThisWorkbook.Worksheets("Лист2")
    Application.ScreenUpdating = False

    If Not Intersect(Target, tbl.DataBodyRange) Is Nothing Then
        ws.Rows("26:" & ws.Rows.Count).ClearContents
        tbl.Range.Copy
        ws.Cells(26, 1).PasteSpecial Paste:=xlPasteValues
    End If

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
[/vba]
Удачи.


Ученик.
 
Ответить
Сообщениеanisimovaleksandr32, Доброго времени суток. Если я вас правильно понял, то вот вам вариант. [vba]
Код
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tbl         As ListObject: Set tbl = ListObjects("Расчет")
    Dim ws          As Worksheet: Set ws = ThisWorkbook.Worksheets("Лист2")
    Application.ScreenUpdating = False

    If Not Intersect(Target, tbl.DataBodyRange) Is Nothing Then
        ws.Rows("26:" & ws.Rows.Count).ClearContents
        tbl.Range.Copy
        ws.Cells(26, 1).PasteSpecial Paste:=xlPasteValues
    End If

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
[/vba]
Удачи.

Автор - MikeVol
Дата добавления - 20.10.2023 в 16:30
anisimovaleksandr32 Дата: Пятница, 20.10.2023, 18:54 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 74
Репутация: 0 ±
Замечаний: 20% ±

MikeVol, спасибо огромнейшее - да вы все верно поняли
Не я наверное ни когда не смогу эти макросы осилить - через запись и то совершаю ошибки (((((
Не могли бы подсказать - почему когда я данный макрос применил к файлу (не в примере) то теперь в ленте не доступно (ячейки - вставить) и не могу дополнить строку в таблицу!?

Все понял почему - потому как там дальше имеются другие умные таблицы - в виду этого нет такой возможности
ИЗВИНТЕ - спасибо!!!


Сообщение отредактировал anisimovaleksandr32 - Пятница, 20.10.2023, 19:22
 
Ответить
СообщениеMikeVol, спасибо огромнейшее - да вы все верно поняли
Не я наверное ни когда не смогу эти макросы осилить - через запись и то совершаю ошибки (((((
Не могли бы подсказать - почему когда я данный макрос применил к файлу (не в примере) то теперь в ленте не доступно (ячейки - вставить) и не могу дополнить строку в таблицу!?

Все понял почему - потому как там дальше имеются другие умные таблицы - в виду этого нет такой возможности
ИЗВИНТЕ - спасибо!!!

Автор - anisimovaleksandr32
Дата добавления - 20.10.2023 в 18:54
anisimovaleksandr32 Дата: Пятница, 20.10.2023, 20:19 | Сообщение № 4
Группа: Пользователи
Ранг: Участник
Сообщений: 74
Репутация: 0 ±
Замечаний: 20% ±

MikeVol, Ваш код работает на ура
НО.
При добавлении/увеличении в основную таблицу "Расчет" строк на второй лист вставляет так вот

Посмотрел как записывал декодер - решил дополнить
[vba]
Код
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tbl         As ListObject: Set tbl = ListObjects("Расчет")
    Dim ws          As Worksheet: Set ws = ThisWorkbook.Worksheets("Лист2")
    Application.ScreenUpdating = False

    If Not Intersect(Target, tbl.DataBodyRange) Is Nothing Then
        ws.Rows("26:" & ws.Rows.Count).ClearContents
        tbl.Range.Copy
        ws.Cells(26, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
[/vba]
Но увы (((( тоже самое
Стиль таблицы он как бы не сохраняет как есть и не продолжает ее если дополнять строки а если удалять строки то который стиль был до этого остается в пустых ячейках


Сообщение отредактировал anisimovaleksandr32 - Пятница, 20.10.2023, 20:21
 
Ответить
СообщениеMikeVol, Ваш код работает на ура
НО.
При добавлении/увеличении в основную таблицу "Расчет" строк на второй лист вставляет так вот

Посмотрел как записывал декодер - решил дополнить
[vba]
Код
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tbl         As ListObject: Set tbl = ListObjects("Расчет")
    Dim ws          As Worksheet: Set ws = ThisWorkbook.Worksheets("Лист2")
    Application.ScreenUpdating = False

    If Not Intersect(Target, tbl.DataBodyRange) Is Nothing Then
        ws.Rows("26:" & ws.Rows.Count).ClearContents
        tbl.Range.Copy
        ws.Cells(26, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
[/vba]
Но увы (((( тоже самое
Стиль таблицы он как бы не сохраняет как есть и не продолжает ее если дополнять строки а если удалять строки то который стиль был до этого остается в пустых ячейках

Автор - anisimovaleksandr32
Дата добавления - 20.10.2023 в 20:19
anisimovaleksandr32 Дата: Пятница, 20.10.2023, 20:26 | Сообщение № 5
Группа: Пользователи
Ранг: Участник
Сообщений: 74
Репутация: 0 ±
Замечаний: 20% ±

MikeVol,
вроде вот так вот отлично получается
[vba]
Код
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tbl         As ListObject: Set tbl = ListObjects("Расчет")
    Dim ws          As Worksheet: Set ws = ThisWorkbook.Worksheets("Лист2")
    Application.ScreenUpdating = False

    If Not Intersect(Target, tbl.DataBodyRange) Is Nothing Then
        ws.Rows("26:" & ws.Rows.Count).ClearContents
        tbl.Range.Copy
        ws.Cells(26, 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False

    End If

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
[/vba]

При добавлении строк отлично идет и стиль повторяется

А вот при уменьшении строк в основной таблице - почему то стиль ячеек не очищается


Сообщение отредактировал anisimovaleksandr32 - Пятница, 20.10.2023, 20:29
 
Ответить
СообщениеMikeVol,
вроде вот так вот отлично получается
[vba]
Код
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tbl         As ListObject: Set tbl = ListObjects("Расчет")
    Dim ws          As Worksheet: Set ws = ThisWorkbook.Worksheets("Лист2")
    Application.ScreenUpdating = False

    If Not Intersect(Target, tbl.DataBodyRange) Is Nothing Then
        ws.Rows("26:" & ws.Rows.Count).ClearContents
        tbl.Range.Copy
        ws.Cells(26, 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False

    End If

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
[/vba]

При добавлении строк отлично идет и стиль повторяется

А вот при уменьшении строк в основной таблице - почему то стиль ячеек не очищается

Автор - anisimovaleksandr32
Дата добавления - 20.10.2023 в 20:26
MikeVol Дата: Пятница, 20.10.2023, 20:38 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 291
Репутация: 51 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
Вместо метода .ClearContents примените .Clear и будет вам счастье.


Ученик.
 
Ответить
СообщениеВместо метода .ClearContents примените .Clear и будет вам счастье.

Автор - MikeVol
Дата добавления - 20.10.2023 в 20:38
anisimovaleksandr32 Дата: Пятница, 20.10.2023, 20:39 | Сообщение № 7
Группа: Пользователи
Ранг: Участник
Сообщений: 74
Репутация: 0 ±
Замечаний: 20% ±

Я понимаю что команда
[vba]
Код
ws.Rows("26:" & ws.Rows.Count).ClearContents
[/vba]
это функция Excel, которую можно использовать в VBA для удаления значений и формул в диапазоне .
И если прописать так эту строку
[vba]
Код
ws.Rows("26:" & ws.Rows.Count).Clear
[/vba]
то все отлично работает с одним лишь НО она тогда формулы оставляет (но при этом сохраняет и стиль в ячейках и при удалении строк и при увеличении строк)



Сообщение отредактировал anisimovaleksandr32 - Пятница, 20.10.2023, 21:05
 
Ответить
СообщениеЯ понимаю что команда
[vba]
Код
ws.Rows("26:" & ws.Rows.Count).ClearContents
[/vba]
это функция Excel, которую можно использовать в VBA для удаления значений и формул в диапазоне .
И если прописать так эту строку
[vba]
Код
ws.Rows("26:" & ws.Rows.Count).Clear
[/vba]
то все отлично работает с одним лишь НО она тогда формулы оставляет (но при этом сохраняет и стиль в ячейках и при удалении строк и при увеличении строк)


Автор - anisimovaleksandr32
Дата добавления - 20.10.2023 в 20:39
MikeVol Дата: Пятница, 20.10.2023, 21:17 | Сообщение № 8
Группа: Проверенные
Ранг: Обитатель
Сообщений: 291
Репутация: 51 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
anisimovaleksandr32, Подождите, что вы мне голову морочите? У вас в теме что прописано, правильно - дублировать таблицу как значения (без формул). Что же вам тогда тут не подходит? [vba]
Код
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tbl As ListObject: Set tbl = ListObjects("Ðàñ÷åò")
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Ëèñò2")
    Application.ScreenUpdating = False

    If Not Intersect(Target, tbl.DataBodyRange) Is Nothing Then
        ws.Rows("26:26").ClearContents
        ws.Rows("27:" & ws.Rows.Count).Clear
        tbl.Range.Copy
        ws.Cells(26, 1).PasteSpecial Paste:=xlPasteValues
        ws.Cells(26, 1).PasteSpecial Paste:=xlPasteFormats
    End If

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
[/vba]
Цитата anisimovaleksandr32, 20.10.2023 в 15:55, в сообщении № 1 ()
Дублирование основной таблицы на другой лист (только знач)


Ученик.

Сообщение отредактировал MikeVol - Пятница, 20.10.2023, 21:22
 
Ответить
Сообщениеanisimovaleksandr32, Подождите, что вы мне голову морочите? У вас в теме что прописано, правильно - дублировать таблицу как значения (без формул). Что же вам тогда тут не подходит? [vba]
Код
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tbl As ListObject: Set tbl = ListObjects("Ðàñ÷åò")
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Ëèñò2")
    Application.ScreenUpdating = False

    If Not Intersect(Target, tbl.DataBodyRange) Is Nothing Then
        ws.Rows("26:26").ClearContents
        ws.Rows("27:" & ws.Rows.Count).Clear
        tbl.Range.Copy
        ws.Cells(26, 1).PasteSpecial Paste:=xlPasteValues
        ws.Cells(26, 1).PasteSpecial Paste:=xlPasteFormats
    End If

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
[/vba]
Цитата anisimovaleksandr32, 20.10.2023 в 15:55, в сообщении № 1 ()
Дублирование основной таблицы на другой лист (только знач)

Автор - MikeVol
Дата добавления - 20.10.2023 в 21:17
anisimovaleksandr32 Дата: Пятница, 20.10.2023, 21:32 | Сообщение № 9
Группа: Пользователи
Ранг: Участник
Сообщений: 74
Репутация: 0 ±
Замечаний: 20% ±

У вас в теме что прописано, правильно - дублировать таблицу как значения (без формул)

Я не думал что нужно писать о том что и стиль таблицы должен быть при этом сохранен ((((
[vba]
Код
       ws.Cells(26, 1).PasteSpecial Paste:=xlPasteValues
        ws.Cells(26, 1).PasteSpecial Paste:=xlPasteFormats
[/vba]

Я если честно уже в ссылки погрузился My WebPage - понимаю что ответ то лежит на поверхности но сообразить при этом не могу как это реализовать (чтоб стиль был и формул не было)

СПАСИБО ВАМ ОГРОМНЕЙШЕЕ


Сообщение отредактировал anisimovaleksandr32 - Пятница, 20.10.2023, 21:49
 
Ответить
Сообщение
У вас в теме что прописано, правильно - дублировать таблицу как значения (без формул)

Я не думал что нужно писать о том что и стиль таблицы должен быть при этом сохранен ((((
[vba]
Код
       ws.Cells(26, 1).PasteSpecial Paste:=xlPasteValues
        ws.Cells(26, 1).PasteSpecial Paste:=xlPasteFormats
[/vba]

Я если честно уже в ссылки погрузился My WebPage - понимаю что ответ то лежит на поверхности но сообразить при этом не могу как это реализовать (чтоб стиль был и формул не было)

СПАСИБО ВАМ ОГРОМНЕЙШЕЕ

Автор - anisimovaleksandr32
Дата добавления - 20.10.2023 в 21:32
MikeVol Дата: Пятница, 20.10.2023, 21:45 | Сообщение № 10
Группа: Проверенные
Ранг: Обитатель
Сообщений: 291
Репутация: 51 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
anisimovaleksandr32, Последний вариант решает все ваши вопросы.


Ученик.
 
Ответить
Сообщениеanisimovaleksandr32, Последний вариант решает все ваши вопросы.

Автор - MikeVol
Дата добавления - 20.10.2023 в 21:45
anisimovaleksandr32 Дата: Пятница, 20.10.2023, 21:50 | Сообщение № 11
Группа: Пользователи
Ранг: Участник
Сообщений: 74
Репутация: 0 ±
Замечаний: 20% ±

MikeVol, да... 100% огромнейшее спасибо
 
Ответить
СообщениеMikeVol, да... 100% огромнейшее спасибо

Автор - anisimovaleksandr32
Дата добавления - 20.10.2023 в 21:50
anisimovaleksandr32 Дата: Понедельник, 23.10.2023, 11:55 | Сообщение № 12
Группа: Пользователи
Ранг: Участник
Сообщений: 74
Репутация: 0 ±
Замечаний: 20% ±

MikeVol, :'( поспешил с ответом на 100%
На листе2 после вставки скопированной таблицы - ниже нее имеется ряд другой информации (которая должна размещаться под таблицей).
В данном макросе:
[vba]
Код
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim tbl  As ListObject: Set tbl = ListObjects("Расчет")
  Dim ws  As Worksheet: Set ws = ThisWorkbook.Worksheets("Лист2")
  Application.ScreenUpdating = False

  If Not Intersect(Target, tbl.DataBodyRange) Is Nothing Then
  ws.Rows("26:26").ClearContents
  ws.Rows("27:" & ws.Range("C27").End(xlDown).Row).Clear  ' Привязался к стодбцу C
  '  ws.Rows("27:" & ws.Rows.Count).Clear
  tbl.Range.Copy
  ws.Cells(26, 1).PasteSpecial Paste:=xlPasteValues
  ws.Cells(26, 1).PasteSpecial Paste:=xlPasteFormats
  End If

  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub
[/vba]

Все удовлетворяет hands но как только оператор увеличивает количество строк в основной таблице
То информация находящая под таблицей (а это к примеру объединенная ячейка через две строки после вставки скопированной таблицы) - ругается на код

картинки для клана pw
А если не объединять ячейки под таблицей то он просто удаляет информацию ((((
Решил посмотреть как будет прописан код если использовать макро декодер
[vba]
Код
Sub Макрос1()
'
' Макрос1 Макрос
'

'
    Range("Расчет[#All]").Copy
    Sheets("Лист4").Range("A10").Insert Shift:=xlDown
End Sub
[/vba]
Применил его на лист 4 и видно что есть смещение при вставке
 
Ответить
СообщениеMikeVol, :'( поспешил с ответом на 100%
На листе2 после вставки скопированной таблицы - ниже нее имеется ряд другой информации (которая должна размещаться под таблицей).
В данном макросе:
[vba]
Код
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim tbl  As ListObject: Set tbl = ListObjects("Расчет")
  Dim ws  As Worksheet: Set ws = ThisWorkbook.Worksheets("Лист2")
  Application.ScreenUpdating = False

  If Not Intersect(Target, tbl.DataBodyRange) Is Nothing Then
  ws.Rows("26:26").ClearContents
  ws.Rows("27:" & ws.Range("C27").End(xlDown).Row).Clear  ' Привязался к стодбцу C
  '  ws.Rows("27:" & ws.Rows.Count).Clear
  tbl.Range.Copy
  ws.Cells(26, 1).PasteSpecial Paste:=xlPasteValues
  ws.Cells(26, 1).PasteSpecial Paste:=xlPasteFormats
  End If

  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub
[/vba]

Все удовлетворяет hands но как только оператор увеличивает количество строк в основной таблице
То информация находящая под таблицей (а это к примеру объединенная ячейка через две строки после вставки скопированной таблицы) - ругается на код

картинки для клана pw
А если не объединять ячейки под таблицей то он просто удаляет информацию ((((
Решил посмотреть как будет прописан код если использовать макро декодер
[vba]
Код
Sub Макрос1()
'
' Макрос1 Макрос
'

'
    Range("Расчет[#All]").Copy
    Sheets("Лист4").Range("A10").Insert Shift:=xlDown
End Sub
[/vba]
Применил его на лист 4 и видно что есть смещение при вставке

Автор - anisimovaleksandr32
Дата добавления - 23.10.2023 в 11:55
MikeVol Дата: Понедельник, 23.10.2023, 12:59 | Сообщение № 13
Группа: Проверенные
Ранг: Обитатель
Сообщений: 291
Репутация: 51 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
anisimovaleksandr32, Доброго времени суток. Приложите файл пример с максимально схожей структурой файла оригинала (таблицу с теми данными что находятся под ней), максимально схожий. Без конфидинциальной информацией.


Ученик.
 
Ответить
Сообщениеanisimovaleksandr32, Доброго времени суток. Приложите файл пример с максимально схожей структурой файла оригинала (таблицу с теми данными что находятся под ней), максимально схожий. Без конфидинциальной информацией.

Автор - MikeVol
Дата добавления - 23.10.2023 в 12:59
anisimovaleksandr32 Дата: Понедельник, 23.10.2023, 13:03 | Сообщение № 14
Группа: Пользователи
Ранг: Участник
Сообщений: 74
Репутация: 0 ±
Замечаний: 20% ±

MikeVol, вот сам файл куда хотел потом применить данный макрос
Лист В35 основная таблица для расчета - которую нужно будет потом скопировать и вставить на листе Заключение
К сообщению приложен файл: v35.xlsm (113.3 Kb)
 
Ответить
СообщениеMikeVol, вот сам файл куда хотел потом применить данный макрос
Лист В35 основная таблица для расчета - которую нужно будет потом скопировать и вставить на листе Заключение

Автор - anisimovaleksandr32
Дата добавления - 23.10.2023 в 13:03
MikeVol Дата: Понедельник, 23.10.2023, 13:51 | Сообщение № 15
Группа: Проверенные
Ранг: Обитатель
Сообщений: 291
Репутация: 51 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
anisimovaleksandr32, Всё зависит от того на сколько
Цитата anisimovaleksandr32, 23.10.2023 в 11:55, в сообщении № 12 ()
оператор увеличивает количество строк в основной таблице

Если не более 4-х строк то ещё терпимо, но если больше то уже придётся пересматривать полностью вопрос. В модуль Листа B35: [vba]
Код
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Set Target = Range("A1")
    If Target = "" Then Exit Sub
    Application.ActiveSheet.Name = VBA.Left(Target, 31)
    Exit Sub
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tbl         As ListObject: Set tbl = ListObjects("Расчет")
    Dim ws          As Worksheet: Set ws = ThisWorkbook.Worksheets("ЗАКЛЮЧЕНИЕ")
    Application.ScreenUpdating = False

    If Not Intersect(Target, tbl.DataBodyRange) Is Nothing Then
        ws.Rows("50:50").ClearContents
        ws.Rows("51:" & ws.Range("C51").End(xlDown).Row).Clear
        tbl.Range.Copy
        ws.Cells(50, 1).PasteSpecial Paste:=xlPasteValues
        ws.Cells(50, 1).PasteSpecial Paste:=xlPasteFormats
        Application.CutCopyMode = False

        ws.Range("A51:A" & ws.Range("C51").End(xlDown).Row).FormulaR1C1 = "=INDEX(В35!R16C3:R100C3, ROW(), COLUMN())"
    End If

    Application.ScreenUpdating = True
End Sub
[/vba]
Код отрабатывает на вашем последнем файле примере без ошибок.


Ученик.

Сообщение отредактировал MikeVol - Понедельник, 23.10.2023, 14:12
 
Ответить
Сообщениеanisimovaleksandr32, Всё зависит от того на сколько
Цитата anisimovaleksandr32, 23.10.2023 в 11:55, в сообщении № 12 ()
оператор увеличивает количество строк в основной таблице

Если не более 4-х строк то ещё терпимо, но если больше то уже придётся пересматривать полностью вопрос. В модуль Листа B35: [vba]
Код
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Set Target = Range("A1")
    If Target = "" Then Exit Sub
    Application.ActiveSheet.Name = VBA.Left(Target, 31)
    Exit Sub
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tbl         As ListObject: Set tbl = ListObjects("Расчет")
    Dim ws          As Worksheet: Set ws = ThisWorkbook.Worksheets("ЗАКЛЮЧЕНИЕ")
    Application.ScreenUpdating = False

    If Not Intersect(Target, tbl.DataBodyRange) Is Nothing Then
        ws.Rows("50:50").ClearContents
        ws.Rows("51:" & ws.Range("C51").End(xlDown).Row).Clear
        tbl.Range.Copy
        ws.Cells(50, 1).PasteSpecial Paste:=xlPasteValues
        ws.Cells(50, 1).PasteSpecial Paste:=xlPasteFormats
        Application.CutCopyMode = False

        ws.Range("A51:A" & ws.Range("C51").End(xlDown).Row).FormulaR1C1 = "=INDEX(В35!R16C3:R100C3, ROW(), COLUMN())"
    End If

    Application.ScreenUpdating = True
End Sub
[/vba]
Код отрабатывает на вашем последнем файле примере без ошибок.

Автор - MikeVol
Дата добавления - 23.10.2023 в 13:51
anisimovaleksandr32 Дата: Понедельник, 23.10.2023, 14:07 | Сообщение № 16
Группа: Пользователи
Ранг: Участник
Сообщений: 74
Репутация: 0 ±
Замечаний: 20% ±

MikeVol, понял
"Если не более 4-х строк то ещё терпимо" - да видать без запроса и Power Query не обойтись ((((. А если офис старый установлен ((((( то пф
[vba]
Код
Sub Макрос1()
'
' Макрос1 Макрос
'

'
    Range("Расчет[#All]").Copy
    Sheets("Лист4").Range("A10").Insert Shift:=xlDown
End Sub
[/vba]
Так будет куда эффективнее тогда - только прописать через активацию листа (если это позволительно будет для эффективности - ну край через кнопку).
 
Ответить
СообщениеMikeVol, понял
"Если не более 4-х строк то ещё терпимо" - да видать без запроса и Power Query не обойтись ((((. А если офис старый установлен ((((( то пф
[vba]
Код
Sub Макрос1()
'
' Макрос1 Макрос
'

'
    Range("Расчет[#All]").Copy
    Sheets("Лист4").Range("A10").Insert Shift:=xlDown
End Sub
[/vba]
Так будет куда эффективнее тогда - только прописать через активацию листа (если это позволительно будет для эффективности - ну край через кнопку).

Автор - anisimovaleksandr32
Дата добавления - 23.10.2023 в 14:07
MikeVol Дата: Понедельник, 23.10.2023, 14:17 | Сообщение № 17
Группа: Проверенные
Ранг: Обитатель
Сообщений: 291
Репутация: 51 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
anisimovaleksandr32, У вас разметка страницы такая, можно ещё 2 строки дать в запас. Выделяете руками строки 84-85 добавить строки. Далее выледяете строки 93-94 удалить строки, так у вас ещё две строки в запасе будет, было 4 стало 6 строк. Там даже
Цитата anisimovaleksandr32, 23.10.2023 в 14:07, в сообщении № 16 ()
Power Query
не поможет так как из-за разметки страницы. Подумайте ещё.


Ученик.
 
Ответить
Сообщениеanisimovaleksandr32, У вас разметка страницы такая, можно ещё 2 строки дать в запас. Выделяете руками строки 84-85 добавить строки. Далее выледяете строки 93-94 удалить строки, так у вас ещё две строки в запасе будет, было 4 стало 6 строк. Там даже
Цитата anisimovaleksandr32, 23.10.2023 в 14:07, в сообщении № 16 ()
Power Query
не поможет так как из-за разметки страницы. Подумайте ещё.

Автор - MikeVol
Дата добавления - 23.10.2023 в 14:17
anisimovaleksandr32 Дата: Понедельник, 23.10.2023, 14:23 | Сообщение № 18
Группа: Пользователи
Ранг: Участник
Сообщений: 74
Репутация: 0 ±
Замечаний: 20% ±

MikeVol, не поможет - да как не поможет то
Смотрите как он справляется на ура и красиво (правда я вот так и не смог применить этот Power Query и запрос создать - к своему файлу) прикладываю пример
На листе 1 по типу основная таблица на лист Sheet1 информация дублируется
К сообщению приложен файл: 1203623.xlsm (100.6 Kb)
 
Ответить
СообщениеMikeVol, не поможет - да как не поможет то
Смотрите как он справляется на ура и красиво (правда я вот так и не смог применить этот Power Query и запрос создать - к своему файлу) прикладываю пример
На листе 1 по типу основная таблица на лист Sheet1 информация дублируется

Автор - anisimovaleksandr32
Дата добавления - 23.10.2023 в 14:23
MikeVol Дата: Понедельник, 23.10.2023, 14:35 | Сообщение № 19
Группа: Проверенные
Ранг: Обитатель
Сообщений: 291
Репутация: 51 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
anisimovaleksandr32, Я извиняюсь конечно. А как же
Цитата anisimovaleksandr32, 23.10.2023 в 11:55, в сообщении № 12 ()
как только оператор увеличивает количество строк в основной таблице
??? К примеру, ваш оператор добавил ещё 5-6 строк в основную таблицу и куда ваша разметка страницы ушла? Вы меня не слышите что я вам говорю. Пробуйте добавить ещё эти 5-6 строк и увидите результат! Я пас.


Ученик.
 
Ответить
Сообщениеanisimovaleksandr32, Я извиняюсь конечно. А как же
Цитата anisimovaleksandr32, 23.10.2023 в 11:55, в сообщении № 12 ()
как только оператор увеличивает количество строк в основной таблице
??? К примеру, ваш оператор добавил ещё 5-6 строк в основную таблицу и куда ваша разметка страницы ушла? Вы меня не слышите что я вам говорю. Пробуйте добавить ещё эти 5-6 строк и увидите результат! Я пас.

Автор - MikeVol
Дата добавления - 23.10.2023 в 14:35
anisimovaleksandr32 Дата: Понедельник, 23.10.2023, 14:44 | Сообщение № 20
Группа: Пользователи
Ранг: Участник
Сообщений: 74
Репутация: 0 ±
Замечаний: 20% ±

MikeVol,
К примеру, ваш оператор добавил ещё 5-6 строк в основную таблицу и куда ваша разметка страницы ушла
Да хоть 10-ть данный лист только для распечатывания - а если даже эта таблица уйдет на следующий лист - то всегда ведь можно применить

не так ли!?
СПАСИБО огромное за отзывчивость и помощь...


Сообщение отредактировал anisimovaleksandr32 - Понедельник, 23.10.2023, 14:45
 
Ответить
СообщениеMikeVol,
К примеру, ваш оператор добавил ещё 5-6 строк в основную таблицу и куда ваша разметка страницы ушла
Да хоть 10-ть данный лист только для распечатывания - а если даже эта таблица уйдет на следующий лист - то всегда ведь можно применить

не так ли!?
СПАСИБО огромное за отзывчивость и помощь...

Автор - anisimovaleksandr32
Дата добавления - 23.10.2023 в 14:44
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Дублирование основной таблицы на другой лист (только знач) (Макросы/Sub)
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

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