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

Вход

Регистрация

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

 

= Мир MS Excel/Объединение таблиц в одной с упоминанием названий исходных - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Объединение таблиц в одной с упоминанием названий исходных (Макросы/Sub)
Объединение таблиц в одной с упоминанием названий исходных
aivella Дата: Среда, 18.09.2019, 13:32 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 37
Репутация: 10 ±
Замечаний: 20% ±

Excel 2013
Добрый день,

Хотелось бы скопировать содержание однотипных таблиц одного файла в одну существующую сводную (первый лист). Так, чтобы в первом столбце существующей сводной таблицы упоминалось название каждой из исходных таблиц.

Макро на простое копирование таблиц уже имеется. А вот как получить название листов в первом столбце?

Буду очень благодарна за подсказку!

Имеющееся Макро:

[vba]
Код
Sub Test()
Dim Wks As Worksheet
Dim RG As Range
Dim strLC As String
Dim i As Integer

For i = 2 To Worksheets.Count
With Worksheets(i).UsedRange
strLC = .Cells(.Rows.Count, .Columns.Count).Address
Set RG = .Range("B31:" & strLC)
RG.Copy Destination:= _
Sheets("SUM").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
End With
Next i

End Sub
[/vba]


Сообщение отредактировал Pelena - Четверг, 19.09.2019, 18:38
 
Ответить
СообщениеДобрый день,

Хотелось бы скопировать содержание однотипных таблиц одного файла в одну существующую сводную (первый лист). Так, чтобы в первом столбце существующей сводной таблицы упоминалось название каждой из исходных таблиц.

Макро на простое копирование таблиц уже имеется. А вот как получить название листов в первом столбце?

Буду очень благодарна за подсказку!

Имеющееся Макро:

[vba]
Код
Sub Test()
Dim Wks As Worksheet
Dim RG As Range
Dim strLC As String
Dim i As Integer

For i = 2 To Worksheets.Count
With Worksheets(i).UsedRange
strLC = .Cells(.Rows.Count, .Columns.Count).Address
Set RG = .Range("B31:" & strLC)
RG.Copy Destination:= _
Sheets("SUM").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
End With
Next i

End Sub
[/vba]
Автор - aivella
Дата добавления - 18.09.2019 в 13:32
Pelena Дата: Среда, 18.09.2019, 13:49 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 19174
Репутация: 4413 ±
Замечаний: ±

Excel 365 & Mac Excel
aivella, оформите код тегами с помощью кнопки # в режиме правки поста

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщениеaivella, оформите код тегами с помощью кнопки # в режиме правки поста
Автор - Pelena
Дата добавления - 18.09.2019 в 13:49
aivella Дата: Четверг, 19.09.2019, 17:20 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 37
Репутация: 10 ±
Замечаний: 20% ±

Excel 2013
Прошу прощения, не разобралась, как включить режим правки.

Переписываю код сюда:

[vba]
Код
Sub Test()
Dim Wks As Worksheet
Dim RG As Range
Dim strLC As String
Dim i As Integer

For i = 2 To Worksheets.Count
With Worksheets(i).UsedRange
strLC = .Cells(.Rows.Count, .Columns.Count).Address
Set RG = .Range("B31:" & strLC)
RG.Copy Destination:= _
Sheets("SUM").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
End With
Next i

End Sub
[/vba]
 
Ответить
СообщениеПрошу прощения, не разобралась, как включить режим правки.

Переписываю код сюда:

[vba]
Код
Sub Test()
Dim Wks As Worksheet
Dim RG As Range
Dim strLC As String
Dim i As Integer

For i = 2 To Worksheets.Count
With Worksheets(i).UsedRange
strLC = .Cells(.Rows.Count, .Columns.Count).Address
Set RG = .Range("B31:" & strLC)
RG.Copy Destination:= _
Sheets("SUM").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
End With
Next i

End Sub
[/vba]
Автор - aivella
Дата добавления - 19.09.2019 в 17:20
boa Дата: Пятница, 20.09.2019, 10:33 | Сообщение № 4
Группа: Друзья
Ранг: Ветеран
Сообщений: 550
Репутация: 167 ±
Замечаний: 0% ±

365
[vba]
Код
Sub Test()
  Dim Wks As Worksheet
  Dim RG As Range
  Dim strLC As String
  Dim i As Long
  Dim iCopyRowsCount As Long
  
  For i = 2 To Worksheets.Count
    With Worksheets(i).UsedRange
      strLC = .Cells(.Rows.Count, .Columns.Count).Address
      Set RG = .Range("B31:" & strLC)
      iCopyRowsCount = .Rows.Count - 30
    End With
    With Sheets("SUM").Cells(Rows.Count, 2).End(xlUp)
      RG.Copy Destination:=.Offset(1, 0)
      .Offset(1, -1).Resize(iCopyRowsCount) = Worksheets(i).Name
    End With
  Next i

End Sub
[/vba]



Сообщение отредактировал boa - Пятница, 20.09.2019, 10:50
 
Ответить
Сообщение[vba]
Код
Sub Test()
  Dim Wks As Worksheet
  Dim RG As Range
  Dim strLC As String
  Dim i As Long
  Dim iCopyRowsCount As Long
  
  For i = 2 To Worksheets.Count
    With Worksheets(i).UsedRange
      strLC = .Cells(.Rows.Count, .Columns.Count).Address
      Set RG = .Range("B31:" & strLC)
      iCopyRowsCount = .Rows.Count - 30
    End With
    With Sheets("SUM").Cells(Rows.Count, 2).End(xlUp)
      RG.Copy Destination:=.Offset(1, 0)
      .Offset(1, -1).Resize(iCopyRowsCount) = Worksheets(i).Name
    End With
  Next i

End Sub
[/vba]
Автор - boa
Дата добавления - 20.09.2019 в 10:33
aivella Дата: Пятница, 20.09.2019, 13:03 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 37
Репутация: 10 ±
Замечаний: 20% ±

Excel 2013
Огромное спасибо!!!

это просто волшебство!!!

Работа заиграла новыми красками!!!

hands
 
Ответить
СообщениеОгромное спасибо!!!

это просто волшебство!!!

Работа заиграла новыми красками!!!

hands
Автор - aivella
Дата добавления - 20.09.2019 в 13:03
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Объединение таблиц в одной с упоминанием названий исходных (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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