如果满足条件，如何将范围从多张纸复制到一张纸（另一个范围下的一个范围）？

Question

我有多个工作表的 Excel 工作簿，如果满足条件，我需要将每个工作表的范围复制到一个“主”工作表（另一个工作表下）。

1. 每张工作表都不同，行数和单元格数也可能不同。
2. 在所有工作表（空白的主工作表除外）中，单元格 B1 是包含“是”或空白的复选单元格。
3. 如果单元格 B1 ="yes"，则宏必须将范围（从第 2 行到填充行的纬度）迁移到主工作表中。
4. 所选范围必须在主工作表中一个接一个地复制（这样它就像一个列表）

我仍然是 VBA 的初学者，如果有人能对我的代码提供一点帮助，我将非常感激 :)。

我尝试使用“For Each - Next”来构建代码，但也许使用 Loop cicle 或其他东西会更好。

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

这里有很多问题 - 我建议您阅读 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

Answer 2

看看这是否有帮助，尽管您可能需要进行一些小的更改以匹配您的数据集..

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