2011年5月5日 星期四

判斷Excel的值並複製到新的分頁

Sub Macro1()
 
   '在Sheet1執行巨集
   Sheet1.Activate
 
   '定義參數
   Dim k As Long, Km As Long

   '從1開始
   Km = 1

   '複製抬頭
   Sheet2.Rows(1).Value = Rows(1).Value
 
   For k = 2 To Range("E65536").End(xlUp).Row
 
      'E欄位
      With Range("E" & k)
   
         If .Value = 3 And .Value <> "" Then
     
            Km = Km + 1
         
            '將k列的資料複製到 Sheet2的Km列
            Sheet2.Rows(Km).Value = Rows(k).Value
         
         End If
      End With
   Next k
 
End Sub