excel中提出特殊數據行 我有壹個表大約如下 XXXXXXXXXXXXX 123 A 34234234 232 B 34355 233 C 343434

Dim People, Pp, Temp

Dim Wsheet As Worksheet

Dim I As Integer

Dim NewRow

Dim CPT1 As String, CPT2 As String, CPT3 As String

For 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

Next

I = 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

Next

I = 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

Next

MsgBox People.Text & "FINISH"

Next

End Sub