Excel VBA根据单元格数据将整行复制到新工作表答案

【问题标题】：Excel VBA copy entire row to new sheet based off cell dataExcel VBA根据单元格数据将整行复制到新工作表
【发布时间】：2016-04-08 19:33:39
【问题描述】：

我是 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

结束子

【问题讨论】：

我认为你有 If c.Value = Worksheet.CodeName Then 倒退。你也没有定义Target？
另外，我认为您的计数器j 需要在End If 之后但在Next 之前发生。
@findwindow 谢谢。既然有 3 个，我该如何定义目标？
我切换了 c.value = worksheet.codename，但我仍然遇到未定义对象的错误。
你需要声明 3 个不同的目标。当我向后说时，我的意思是你的逻辑。您需要遍历您的代号，而不是范围。

标签： vba excel

【解决方案1】：

Worksheet .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 中有某种列标题标签，如果没有低于该值的值。

【讨论】：