Как скопировать диапазон с нескольких листов на один лист (один диапазон под другим), если выполняется условие?

Question

У меня есть и превосходная рабочая книга с несколькими листами, и мне нужно, чтобы диапазон от каждого из них был скопирован в один «Основной» лист (один под другим), если выполняется условие.

1. Каждый лист отличается, и число строк и ячеек может отличаться.
2. На всех листах (кроме основного листа, который является пустым), ячейка B1 является контрольной ячейкой, которая содержит «да» или является пустой.
3. Если ячейка B1 = "yes", макрос должен перенести диапазон (от строки 2 до последнего заполненного ряда) в основной лист.
4. Выбранные диапазоны должны быть скопированы один под другим на главном листе (чтобы он был похож на список)

Я все еще новичок в VBA, и если бы кто-нибудь мог немного помочь мне с кодом, я был бы очень признателен:).

Я пытался встроить код, используя «For Each - Next», но, возможно, было бы лучше сделать это с помощью цикла Loop или чего-то еще.

Sub Migrate_Sheets()  
    Dim wksh As Worksheet, DB_range As Range, end_row As Long, con_cell As Variant

    con_cell = Range("B1")
    'end_row = Range("1048576" & Rows.Count).End(xlUp).Rows

    For Each wksh In Worksheets
        If con_cell = "Yes" Then            
            Set DB_range = Range("2" & Rows.Count).End(xlDown).Rows 
            DB_range.Copy

            wksh("Main").Activate
            'row_end = Range("2" & Rows.Count).End(xlUp).Rows

            Range("A1").End(xlDown).Offset(1, 0).Paste   
        End If      
    Next wksh         
End Sub

Answer 1

Посмотрите, поможет ли это, хотя вам может потребоваться внести незначительные изменения в соответствии с вашими наборами данных.

Sub Migrate_Sheets()
    Dim wksh As Worksheet, mainWS As Worksheet
    Dim DB_range As Range, con_cell As String

    Dim lRow As Long, lCol As Long, lRowMain As Long

    Set mainWS = ThisWorkbook.Worksheets("Main")

    For Each wksh In Worksheets
        con_cell = wksh.Range("B1").Value         'You want to use this variable within the loop

        If wksh.Name <> "Main" And con_cell = "Yes" Then
            lRowMain = lastRC(mainWS, "row", 1) + 1     'Add 1 to the last value to get first empty row
            lRow = lastRC(wksh, "row", 1)               'Get the last row at column 1 - adjust to a different column if no values in column 1
            lCol = lastRC(wksh, "col", 2)               'Get the last column at row 2 - adjust to a different row if no values in row 2

            With mainWS
                .Range(.Cells(lRowMain, 1), .Cells(lRowMain + lRow - 1, lCol)).Value = wksh.Range(wksh.Cells(2, 1), wksh.Cells(lRow, lCol)).Value
            End With

        End If
    Next wksh
End Sub

Function lastRC(sht As Worksheet, RC As String, Optional RCpos As Long = 1) As Long

    If RC = "row" Then
      lastRC = sht.Cells(sht.Rows.Count, RCpos).End(xlUp).row

    ElseIf RC = "col" Then
      lastRC = sht.Cells(RCpos, sht.Columns.Count).End(xlToLeft).Column

    Else
        lastRC = 0

    End If
End Function

Answer 2

Здесь довольно много проблем - я предлагаю вам ознакомиться с основами VBA - синтаксисом, объектами, методами и т. Д.

Я предположил, что вы копируете только столбец B.

Sub Migrate_Sheets()

Dim wksh As Worksheet, DB_range As Range

For Each wksh In Worksheets
    If wksh.Name <> "Main" Then 'want to exclude this sheet from the check
        If wksh.Range("B1").Value = "Yes" Then 'refer to the worksheet in the loop
            Set DB_range = wksh.Range("B2", wksh.Range("B" & Rows.Count).End(xlUp)) 'you need Set when assigning object variables
            DB_range.Copy Worksheets("Main").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) 'better to work up from the bottom and then go down 1
        End If
    End If
Next wksh

End Sub