Excel VBA根據單元格數據將整個行復制到新工作表

Question

我對Excel VBA非常陌生，需要一些幫助。 我有一個數據列表，我希望根據B列中的數據將其復制到新工作表中，並將整行復制到同名新工作表中。

Column B
2nd Black
1st Black
1st Brown
2nd Brown
3rd Brown

我已經更改了代碼並提出了這個建議。 一切正常。 謝謝你的幫助。

Sub create_role()
Dim c As Range
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim Source As Worksheet
Dim Target As Worksheet

Set Source = ActiveWorkbook.Worksheets("master")

j = 11
k = 11
l = 11
m = 11

For Each c In Source.Range("b11:b110")
    If (c = "5th Black" Or c = "4th Black" Or c = "3rd Black" Or c = "2nd Black" Or c = "1st Black" Or c = "Jr. Black") Then
       Set Target = ActiveWorkbook.Worksheets("BLACK")
       Source.Rows(c.Row).Copy Target.Rows(j)
    ElseIf c = "1st Brown" Then
        Set Target = ActiveWorkbook.Worksheets("1ST BROWN")
        Source.Rows(c.Row).Copy Target.Rows(k)
        k = k + 1
    ElseIf c = "2nd Brown" Then
        Set Target = ActiveWorkbook.Worksheets("2ND BROWN")
        Source.Rows(c.Row).Copy Target.Rows(l)
        l = l + 1
    ElseIf c = "3rd Brown" Then
        Set Target = ActiveWorkbook.Worksheets("3RD BROWN")
        Source.Rows(c.Row).Copy Target.Rows(m)
        m = m + 1
    End If

    j = j + 1

Next c

結束子

Answer 1

通過其Worksheet .Name屬性對工作表的任何引用都不區分大小寫，您可以利用它。

Option Explicit

Sub create_role()
    Dim src As String, trgtws As String, c As Range

    With ActiveWorkbook.Worksheets("master")

        For Each c In .Range(.Cells(11, "B"), .Cells(Rows.Count, "B").End(xlUp))
            trgtws = vbNullString
            src = StrConv(c.Value2, vbProperCase)
            Select Case True
                Case src Like "*Black"
                    trgtws = "BLACK"
                Case src Like "*Brown"
                    trgtws = UCase(src)
                Case Else
                    'do nothing
            End Select

            If CBool(Len(trgtws)) Then
                With .Parent.Worksheets(trgtws)
                    c.EntireRow.Copy _
                      Destination:=.Cells(.Cells(Rows.Count, "B").End(xlUp).Row, "A")
                End With
            End If
        Next c

    End With
End Sub

我已將您的條件方法更改為Select Case語句 ，該語句應使擴展到更多條件變得容易，但您可以在這里使用IF ... ElseIf ... End If 。

目標位置假定每個工作表的B10中都有某種列標題標簽（如果下面沒有任何值）。