如何在一个工作表到多个工作表中复制首选列数据

Question

在我的办公室中，五名员工正在工作，例如在我的办公室中，工作条目退出表格已经过了..

这是主页

现在我的要求 类别明智的数据复制到此工作表到其他工作表，但它是自动执行
例如

enter image description here

Answer 1

我希望我正确地解释您的问题，但如果我误解了您的请求，请告诉我。

在工作表上尝试以下代码：

Sub AutoCopyByName()

Dim Names() As String
Dim i As Long, NumRows As Long, NameRow() As Long
Dim j As Integer, NumNames As Integer

j = 0
NumSites = 0

'''''''''''''''''''''''''''''''''''''''''''
'''COUNT NUMBER OF ROWS WITH INFORMATION'''
'''''''''''''''''''''''''''''''''''''''''''
i = 2 'Standard Counter (counts all non-blank cells)
NumRows = 1 'Number of rows with information
Do While WorksheetFunction.IsText(Sheets("data").Range("A" & i))
    If Sheets("data").Range("A" & i) <> " " Then NumRows = NumRows + 1
    i = i + 1
Loop

'''''''''''''''''''''''''''
'''COUNT NUMBER OF NAMES'''
'''''''''''''''''''''''''''
For i = 3 To NumRows + 1
    If Sheets("data").Cells(i, 1) <> Sheets("data").Cells(i - 1, 1) Then NumNames = NumNames + 1 'Works
Next i

''''''''''''''''''
'''REDIM ARRAYS'''
''''''''''''''''''
ReDim Names(NumNames)
ReDim NameRow(NumNames)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''FINDING THE LOCATION OF EACH NAME IN THE SHEET AND STORING IT IN NameRow ARRAY'''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For i = 2 To NumRows + 1
    If Sheets("data").Cells(i, 1) <> Sheets("data").Cells(i - 1, 1) Then
        Names(j) = Sheets("data").Cells(i, 1).Value
        NameRow(j) = i
        j = j + 1
    End If
Next i

'''''''''''''''''''''''''''''''''''''''''
'''COPY ENTRIES PER NAME TO EACH SHEET'''
'''''''''''''''''''''''''''''''''''''''''
For i = 0 To NumNames - 1
Worksheets.Add
Worksheets(1).Name = Names(i)
Worksheets("data").Rows(1).Copy
Worksheets(Names(i)).Paste
Worksheets("data").Activate
Worksheets("data").Range(Cells(NameRow(i), 1), Cells(NameRow(i + 1) - 1, 1)).EntireRow.Copy
Worksheets(Names(i)).Activate
Worksheets(Names(i)).Range("A2").Select
Worksheets(Names(i)).Paste

Next i

End Sub

我已将以下内容用作输入表