excel中提出特殊数据行 我有一个表大约如下 XXXXXXXXXXXXX 123 A 34234234 232 B 34355 233 C 343434

Sub 按钮1_单击()Dim People, Pp, TempDim Wsheet As WorksheetDim I As IntegerDim NewRowDim CPT1 As String, CPT2 As String, CPT3 As StringFor Each People In Sheets("人员").Range("A1:A1000")I = 0 If People = "" Then Exit For End If CPT1 = Sheets("SHEET1").Range("D1") CPT2 = Sheets("SHEET2").Range("B1"迅高) CP3 = Sheets("SHEET3").Range("B1") ActiveWorkbook.Sheets.Add ActiveSheet.Name = People Sheets(People.Text).Range("C1") = CPT1 Sheet1.Activate For Each Pp In Sheets("州虚sheet1").Range("C2:C83") If Pp = People Then Pp.Activate NewRow = ActiveCell.EntireRow Sheets(People.Text).Rows("2:2").Offset(I) = NewRow I = I + 1 End If NextI = I + 1 Sheets(People.Text).Range("c1").Offset(I) = CPT2 Sheets(People.Text).Activate Sheets("SHEET2").Activate For Each Pp In Sheets("sheet2").Range("C3:C86") If Pp = People Then Pp.Activate NewRow = ActiveCell.EntireRow Sheets(People.Text).Rows("2:2").Offset(I) = NewRow I = I + 1 End If NextI = I + 1 Sheets(People.Text).Activate Sheets("SHEET3").Activate Sheets(People.Text).Range("c1"亩迹尺).Offset(I) = CPT3 For Each Pp In Sheets("sheet3").Range("a3:a1101") If Pp = People Then Pp.Activate NewRow = ActiveCell.EntireRow Sheets(People.Text).Rows("2:2").Offset(I) = NewRow I = I + 1 End If NextMsgBox People.Text & "FINISH"NextEnd Sub