資料轉寫

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

1^# 跳轉到 »

發表於 2012-4-27 09:28 | 顯示全部帖子

回復 1# man65boy

Option Explicit
Sub Ex()
Dim A As Range, R As Range, Rng As Range
With Sheet1
.AutoFilterMode = False ' 取消[自動篩選]
.Range("a1").AutoFilter 5, "自取" '[自動篩選] 設定第5欄的篩選準則 = "自取"
With .UsedRange.SpecialCells(xlCellTypeVisible) '自動篩選後的資料
.Copy Sheet2.[A1] '複製資料
For Each A In .Areas 'Areas 屬性: 此集合代表多重範圍中的所有範圍。唯讀
For Each R In .Rows '範圍的整列
If R.Row <> 1 Then '列號不是欄位的列號
If Rng Is Nothing Then
Set Rng = R
Else
Set Rng = Union(Rng, R) 'Union 方法定傳回兩個或多個範圍的合併範圍
End If
End If
Next
Next
End With
.AutoFilterMode = False ' 取消[自動篩選]
If Not Rng Is Nothing Then '自動篩選有資料
Application.DisplayAlerts = False 'DisplayAlerts 屬性 Microsoft Excel 顯示特定的警告和訊息則為 True。讀/寫 Boolean。
Rng.Delete '刪除自動篩選後的資料
Application.DisplayAlerts = True
Else '自動篩選沒有資料
MsgBox "查烏資料"
End If
End With
End Sub

複製代碼

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2012-4-28 07:34 | 顯示全部帖子

本帖最後由 GBKEE 於 2012-4-29 15:52 編輯

回復 4# man65boy
並無法往下排列，稍點不足修正了

複製代碼

靜思自在 : 君子立恆志，小人恆立志。