Excel automatic, if category = X则复制行并粘贴到选项卡X中

时间:2022-12-30 20:10:44

I want to create an excel document with a complete list of tasks in 1 tab (all tasks) and the tabs supplier #1, supplier #2, supplier #3.

我想创建一个excel文档,其中包含一个选项卡(所有任务)和选项卡(选项卡供应商1、供应商2、供应商3)中的完整任务列表。

I have the following columns:

我有以下专栏:

Task | Category (suppliers) | Action | Reference number |

|类(供应商)|行动|参考编号|

How can I automate when a category matches the same name as a tab it auto copies the complete row and insert this this in the supplier tab?

当一个类别与一个标签匹配时,我如何自动复制完整的行并将其插入到供应商标签中?

Thanks in advance,

提前谢谢,

1 个解决方案

#1


1  

The following worked for me:

以下为我工作:

Sub CopyRowIfMatchesTab()
Dim category As String
Dim lastTasksRow, lastPasteRow, rowCnt As Long
Dim taskSheet As Worksheet, pasteSheet As Worksheet

Set taskSheet = Sheets("Tasks")
lastTasksRow = taskSheet.Cells(taskSheet.Rows.Count, 1).End(xlUp).Row

For rowCnt = 2 To lastTasksRow

    category = taskSheet.Cells(rowCnt, 2).Value
    Set pasteSheet = Nothing

    On Error Resume Next
        Set pasteSheet = Sheets(category)
    On Error GoTo 0

    If Not pasteSheet Is Nothing Then
        lastPasteRow = pasteSheet.Cells(pasteSheet.Rows.Count, 1).End(xlUp).Row
        taskSheet.Rows(rowCnt).Copy
        pasteSheet.Select
        If lastPasteRow = 1 Then
            pasteSheet.Rows(lastPasteRow).Select
        Else
            pasteSheet.Rows(lastPasteRow + 1).Select
        End If
        pasteSheet.Paste
    End If
Next
End Sub

#1


1  

The following worked for me:

以下为我工作:

Sub CopyRowIfMatchesTab()
Dim category As String
Dim lastTasksRow, lastPasteRow, rowCnt As Long
Dim taskSheet As Worksheet, pasteSheet As Worksheet

Set taskSheet = Sheets("Tasks")
lastTasksRow = taskSheet.Cells(taskSheet.Rows.Count, 1).End(xlUp).Row

For rowCnt = 2 To lastTasksRow

    category = taskSheet.Cells(rowCnt, 2).Value
    Set pasteSheet = Nothing

    On Error Resume Next
        Set pasteSheet = Sheets(category)
    On Error GoTo 0

    If Not pasteSheet Is Nothing Then
        lastPasteRow = pasteSheet.Cells(pasteSheet.Rows.Count, 1).End(xlUp).Row
        taskSheet.Rows(rowCnt).Copy
        pasteSheet.Select
        If lastPasteRow = 1 Then
            pasteSheet.Rows(lastPasteRow).Select
        Else
            pasteSheet.Rows(lastPasteRow + 1).Select
        End If
        pasteSheet.Paste
    End If
Next
End Sub