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

End Sub

Answer 1

工作表.Name property对工作表的任何引用都不区分大小写，您可以利用它。

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 statement，这样可以更轻松地扩展到更多条件，但您可以在此使用IF ... ElseIf ... End If。

目标位置假设每个工作表的B10中都有某种列标题标签，如果下面没有值。

Excel VBA将整行复制到基于单元格数据的新工作表

1 个答案: