Excelブックで新しいページを作成します

最初に、以前の投稿で、このフォーラムがメールアドレスのように見えるものをすべて削除していることがわかります.

あなたの質問から、あなたはコードを書くための知識を持っていると思います.したがって、プロジェクトを進める方法についてのいくつかのポインタだけが必要です.

次のコード例は、ワークシートをループし、フィルターに一致するデータをコピーします(この場合、フィルターは「はい」になります).データを一致させるためにコードを少し編集する必要があるので、うまくいけばそれができます.

「ケースの選択」コードにはCaseステートメントが1つしか表示されませんが、フィルターとコピーのプロセスに含めるシートをリストする簡単な方法です. (ここに出力シートを含めないでください)

次のコードについて説明します(Withステートメント行の後にいくつかのコード行がありますが、コメントで説明されているため、省略しています).

With.AutoFilter.Range 'これは、自動フィルター処理されたデータのgenericrangeオブジェクトです.(列ヘッダーと表示および非表示のデータを含む)

Set rngSource=.Offset(1、0)_'オフセットは列ヘッダーから1行下に移動しますが、下部に余分な空白行が含まれます.

.Resize(.Rows.Count-1、.Columns.Count)_'サイズ変更は、前の手順で余分な行を削除するために1行減少します

.SpecialCells(xlCellTypeVisible) '可視セルのみ(自明)

わからないことがあれば、遠慮なく私に連絡してください.

Sub Macro1()
Dim ws As Worksheet
Dim wsDestin As Worksheet
Dim rngSource As Range
Dim rngDestin As Range
'出力シートがすでに存在するかどうかをテストします
エラー時次を再開
Set wsDestin=Worksheets( "Output") '"Output"を必要な名前に編集
On Error GoTo 0
If wsDestin Is Nothing Then
'シートが存在しないため、作成
Set wsDestin=Sheets.Add(After:= Worksheets(Sheets.Count))
With wsDestin
.Name="Output" '"Output"を目的の名前に編集
'必要な列ヘッダーに編集出力
.Cells(1、 "A")= "シーケンス番号" '
.Cells(1、 "B")= "数量"
.Cells(1、 "C")= "単価 "
.Cells(1、" D ")="合計価格 "
.Rows(1).Font.Bold=True
End With
Else
'シートが存在するため列ヘッダーの下のデータを削除します
wsDestinを使用
.Range(.Cells(2、 "A")、.Cells(.Rows.Count、 "A").End(xlUp)).EntireRow.ClearContents
End With
End If
For Each ws In Worksheets
Select Case ws.Name
Case "Sheet1"、 "Sheet2"、 "Sheet3 "'コピーに含めるシートのリストでこの行を編集します
With ws
.Columns.Hidden=False'すべての列を再表示します
.AutoFilterMode=False 'オートフィルターをオフにして、フィルター処理が既に行われていないことを確認します
.Range( "C:C、E:E、F:F、H:H").EntireColumn.Hidden=True '必要な列を非表示にする
.UsedRange.AutoFilter'オートフィルターをオンにする
.AutoFilter.Range
.AutoFilter Field:= 8、Criteria1:= "Yes" '8をフィルター列番号に編集
'次の行は、列ヘッダーより多くが表示されることをテストします
If.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count>1 Then
Set rngSource=.Offset(1、0)_
.Resize(.Rows.Count-1、.Columns.Count)_
.SpecialCells (xlCellTypeVisible)
Else
MsgBox "データがありません"&ws.Name&vbCrLf&_
"処理は次のシートにスキップします."
GoTo SkipSheet
End If
End With
With wsDestin
Set rngDestin=.Cells(.Rows.Count、 "A").End(xlUp).Offset(1、0)
End With
rngSource.コピー先:= rngDestin
.Columns().Hidden=False '列を再表示
.AutoFilterMode=False'オートフィルターを削除
終了
終了選択
スキップシート:
次のws
wsDestin.Columns().AutoFit
'オブジェクト変数のクリーンアップ
Set rngSource=Nothing
Set rngDestin=Nothing
Set wsDestin=Nothing
Set ws=Nothing
End Sub