|
▼ののか さん:
>オートフィルターで作業しようとしましたが、
>なにぶんデータが大量ですので時間がものすごくかかってします・・・。
>本当は検索値と一致するシート名のシートに行で移動させたいのですが。
先ほど掲示板に投稿したコード、実際にExcel標準モジュールに書いて
実行してみました。
Option Explicit
Sub AAの抽出転記_AutoFilter()
Dim AAsheet As Worksheet
Dim ws As Worksheet
Dim fCount As Long
Dim CopyTo As Range
With ActiveWorkbook.Worksheets
On Error Resume Next
Set AAsheet = .Item("AA") '転記先シート
On Error GoTo 0
If AAsheet Is Nothing Then
If MsgBox("「AA」シートがありません。作成しますか?", _
vbOKCancel) = vbOK Then
Set AAsheet = .Add(After:=.Item(.Count))
AAsheet.Name = "AA"
Else
Exit Sub
End If
Else
AAsheet.UsedRange.ClearContents
End If
End With
For Each ws In ActiveWorkbook.Worksheets
If IsNumeric(ws.Name) Then
ws.AutoFilterMode = False
With ws.Cells(1).CurrentRegion
.AutoFilter 3, "AA"
If .Columns(1).SpecialCells(xlVisible).Count > 1 Then
Set CopyTo = AAsheet.Cells(Rows.Count, 1).End(xlUp)
fCount = fCount + 1
If fCount = 1 Then
.Copy CopyTo
Else
Intersect(.Cells, .Offset(1)).Copy CopyTo.Offset(1)
End If
End If
.AutoFilter
End With
End If
Next
MsgBox "抽出転記しました", vbInformation
End Sub
こちらではシート枚数とデータが少ないせいか、
一瞬で終わりましたが。(^^
処理速度が気になるようでしたら AdvancedFilter に移行ですね。
|
|