Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Макросом собрать определенные диапазоны из таблиц на листах в одну общую,шапки одинаковые
 
#1
30.06.2020 13:47:52
Код
Sub Макрос2()
'
' Макрос2 Макрос
'
' Сочетание клавиш: Ctrl+ц
'
    Sheets("производство").Select
    Range("B2:I2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("ВЕСЬ ПЕРСОНАЛ").Select
    Range("B2").Select
    ActiveSheet.Paste
    
    Sheets("склад").Select
    Range("B2:I2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ВЕСЬ ПЕРСОНАЛ").Select
    Selection.End(xlDown).Select
    Range("B96").Select
    ActiveSheet.Paste
    Sheets("учебный центр").Select
    Range("B2:I2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ВЕСЬ ПЕРСОНАЛ").Select
    Selection.End(xlDown).Select
    Range("B99").Select
    ActiveSheet.Paste
    Sheets("АХО").Select
    Range("B2:I2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ВЕСЬ ПЕРСОНАЛ").Select
    Selection.End(xlDown).Select
    Selection.End(xlUp).Select
    Range("B100").Select
    ActiveSheet.Paste
    Sheets("бухгалтерия").Select
    Range("B2:I2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ВЕСЬ ПЕРСОНАЛ").Select
    Selection.End(xlDown).Select
    Range("B110").Select
    ActiveSheet.Paste


End Sub

Пример во вложении.
Про PQ вкурсе , но пока что и экселя нет даже 2013-го с PQ и девочке которой будет передаю дела проще будет нажать накнопку, чем объяснять ей PQ.

Записал макрос, чтоб собрать определенные диапазоны из таблиц на листах в одну общую,шапки одинаковые.
Но он похоже "одноразовый", тк при вставке выбирается конкретная ячейка.

А как указать , чтобы выбиралась при вставке пустая ячейка , следующая после последней строки предыдущей встваки.
Изменено: OlegMTS - 30.06.2020 13:55:15
 
 
 
#2
01.07.2020 09:04:36
OlegMTS, не очень понятно но вдруг как в сказке)
Код
Sub all_staff()
Dim sh As Worksheet
Dim staff As Worksheet
Dim i As Long
Dim lr As Long
Dim lr2 As Long
Application.ScreenUpdating = False
Set staff = Worksheets("ВЕСЬ ПЕРСОНАЛ")
For Each sh In Worksheets
    If sh.Name <> "ВЕСЬ ПЕРСОНАЛ" And sh.Name <> "Оперативный отчет" Then
        lr = sh.Cells(Rows.Count, 3).End(xlUp).Row
        sh.Range("B2:L" & lr).Copy
        lr2 = staff.Cells(Rows.Count, 3).End(xlUp).Row + 1
        staff.Range("B" & lr2).PasteSpecial xlPasteValues
    End If
Next sh
For i = 1 To staff.Cells(Rows.Count, 3).End(xlUp).Row
staff.Cells(i + 1, 1) = i
Next i
Application.ScreenUpdating = True
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
 
 
Страницы: 1
Наверх