Поменять таблицы местами

[Makroshka]

Есть лист на котором находятся 2 таблицы разделенные несколькими строчками. Нужно скопировать таблицы и вставить на вспомогательный лист "Расход", но так чтобы нижняя оказалась наверху, а верхняя внизу. Мне это необходимо для работы макроса(в нем пыталась поменять переменные, но не получилось).

[Aleksandr H.]

v1

Sub makro()
    Dim sh1 As Worksheet, shr As Worksheet 'sheet
    Dim r As Long, rr As Long
    Dim rng1 As Range, rng2 As Range
    Set sh1 = Sheets("1")
    Set shr = Sheets("Расход")
    r = 2
    With sh1
        Do While .Cells(r, "A") <> ""
         r = r + 1
        Loop
        rr = r - 1
        Set rng1 = .Range("A2:F" & r)
        Do While .Cells(r, "A") = ""
          r = r + 1
        Loop
        Set rng2 = .Range("A" & r & ":F" & .Cells(.Rows.Count, 1).End(xlUp).Row)
        rng2.Copy
        shr.[a2].PasteSpecial
        rng1.Copy
        shr.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row - rr, "A").PasteSpecial
        
    End With
    Set sh1 = Nothing
    Set shr = Nothing
End Sub

v2. если порядок вывода не важен

Sub makro2()
    Dim sh1 As Worksheet, shr As Worksheet
    Dim r As Long, rr As Long
    Dim rng1 As Range
    Set sh1 = Sheets("1")
    Set shr = Sheets("Расход")
    
    With sh1
        r = .Cells(.Rows.Count, 1).End(xlUp).Row
        Do While r >= 2
            rr = shr.Cells(.Rows.Count, 1).End(xlUp).Row + 1
            Set rng1 = .Range("A" & r & ":F" & r)
            rng1.Copy
            shr.Cells(rr, "A").PasteSpecial
            r = r - 1
        Loop
    End With
    Set sh1 = Nothing
    Set shr = Nothing
End Sub

[Makroshka]

Спасибо, работает. А можно поподробнее что за что отвечает. Только начала изучать vba и хотелось бы понимать код

[Aleksandr H.]

Сообщение от Makroshka

Спасибо, работает. А можно поподробнее что за что отвечает. Только начала изучать vba и хотелось бы понимать код

Давай наоборот: ты пишешь что поняла, а тогда смотрим что не поняла

[Makroshka]

Использовала этот код

Sub makro()
    Dim sh1 As Worksheet, shr As Worksheet 'sheet 'назначение переменных по страницам?
    Dim r As Long, rr As Long ' переменные для диапазонов
    Dim rng1 As Range, rng2 As Range ' переменные для выделения(?) диапазонов
    Set sh1 = Sheets("1") 'назначение переменных по страницам?
    Set shr = Sheets("Расход") 'назначение переменных по страницам?
    r = 2
    With sh1 'код работает на странице "1"
        Do While .Cells(r, "A") <> "" 'определяем границы 1 таблицы(?)
         r = r + 1
        Loop
        rr = r - 1
        Set rng1 = .Range("A2:F" & r) ' выделяем диапазон по последнюю строку
        Do While .Cells(r, "A") = ""
          r = r + 1
        Loop
        Set rng2 = .Range("A" & r & ":F" & .Cells(.Rows.Count, 1).End(xlUp).Row)
        rng2.Copy
        shr.[a2].PasteSpecial
        rng1.Copy
        shr.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row - rr, "A").PasteSpecial
        
    End With
    Set sh1 = Nothing
    Set shr = Nothing
End Sub

[Aleksandr H.]

Sub makro()
    Dim sh1 As Worksheet, shr As Worksheet 'sheet 'назначение переменных по страницам?
    Dim r As Long, rr As Long ' переменные для диапазонов
    Dim rng1 As Range, rng2 As Range ' переменные для выделения(?) диапазонов
    Set sh1 = Sheets("1") 'назначение переменных по страницам?
    Set shr = Sheets("Расход") 'назначение переменных по страницам?
    r = 2 ' начальная строка, с которой "идем вниз"
    With sh1 'код работает на странице "1". Работаем с листом sh1
        Do While .Cells(r, "A") <> "" 'определяем границы 1 таблицы(?) 
         r = r + 1 ' "шагаем вниз" пока не найдем пустой ячейки. Если нашли - нашли границу 1 таблицы
        Loop
        rr = r - 1 ' так как "перешагнули" пустую строку, то надо запомнить -1 от границы
        Set rng1 = .Range("A2:F" & r) ' выделяем диапазон по последнюю строку
        Do While .Cells(r, "A") = "" ' ищем начала 2ой таблицы
          r = r + 1
        Loop
        Set rng2 = .Range("A" & r & ":F" & .Cells(.Rows.Count, 1).End(xlUp).Row) ' выделяем 2ю таблицу
        rng2.Copy ' копируем 2ю таблицу
        shr.[a2].PasteSpecial ' вставляем в А2 листа shr2
        rng1.Copy 
        shr.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row - rr, "A").PasteSpecial
    End With
    Set sh1 = Nothing
    Set shr = Nothing
End Sub

[Makroshka]

Спасибо за пояснение)))

[Makroshka]

А если мне надо этот код на нескольких страницах провести? Пробую вводить новые переменные и мне выдает ошибку. Что я делаю не так?

Dim sh1 As Worksheet, shr1 As Worksheet, sh2 As Worksheet, shr2 As Worksheet 'sheet 'назначение переменных по страницам

    Dim r As Long, rr As Long ' переменные для диапазонов
    Dim rng1 As Range, rng2 As Range ' переменные для выделения диапазонов
    Dim r2 As Long, rr2 As Long ' переменные для диапазонов
    Dim rng12 As Range, rng22 As Range ' переменные для выделения диапазонов
   
    Set sh1 = Sheets("1") 'назначение переменных по страницам
    Set sh2 = Sheets("2")
    
    Set shr1 = Sheets("Расход1") 'назначение переменных по страницам
    Set shr2 = Sheets("Расход2")
   
    r = 2 ' начальная строка, с которой "идем вниз"
    
    With sh1 'код работает на странице "1". Работаем с листом sh1
        Do While .Cells(r, "A") <> "" 'определяем границы 1 таблицы
         r = r + 1 ' "шагаем вниз" пока не найдем пустой ячейки. Если нашли - нашли границу 1 таблицы
        Loop
        rr = r - 1 ' так как "перешагнули" пустую строку, то надо запомнить -1 от границы
        Set rng1 = .Range("A2:F" & r) ' выделяем диапазон по последнюю строку
        Do While .Cells(r, "A") = "" ' ищем начала 2ой таблицы
          r = r + 1
        Loop
        Set rng2 = .Range("A" & r & ":F" & .Cells(.Rows.Count, 1).End(xlUp).Row) ' выделяем 2ю таблицу
        rng2.Copy ' копируем 2ю таблицу
        shr1.[a1].PasteSpecial ' вставляем в А2 листа shr2
        rng1.Copy
        shr1.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row - rr, "A").PasteSpecial
    End With
    Set sh1 = Nothing
    Set shr1 = Nothing
    
    With sh2 'код работает на странице "1". Работаем с листом sh1
        Do While .Cells(r2, "A") <> "" 'определяем границы 1 таблицы(ЗДЕСЬ МНЕ ВЫДАЕТ ОШИБКУ)
         r2 = r2 + 1 ' "шагаем вниз" пока не найдем пустой ячейки. Если нашли - нашли границу 1 таблицы
        Loop
        rr2 = r2 - 1 ' так как "перешагнули" пустую строку, то надо запомнить -1 от границы
        Set rng12 = .Range("A2:F" & r2) ' выделяем диапазон по последнюю строку
        Do While .Cells(r2, "A") = "" ' ищем начала 2ой таблицы
          r2 = r2 + 1
        Loop
        Set rng22 = .Range("A" & r2 & ":F" & .Cells(.Rows.Count, 1).End(xlUp).Row) ' выделяем 2ю таблицу
        rng22.Copy ' копируем 2ю таблицу
        shr2.[a1].PasteSpecial ' вставляем в А2 листа shr2
        rng12.Copy
        shr2.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row - rr2, "A").PasteSpecial
    End With
    Set sh2 = Nothing
    Set shr2 = Nothing

[Aleksandr H.]

Перед with sh2, надо прописать r2 =2. Сейчас р2=0, поэтому и ошибка.

[Makroshka]

Спасибо)