マクロの作成経験は限られています。現在、マスターワークシート全体をコピーして他のワークシートに貼り付けてから、特定の列の「X」をソートしてマスターワークシート上の他の行を削除します。Excelのマクロ：列Bに「X」がある場合は、行全体をコピーし、「列B」という名前のワークシートに貼り付けます。
マスターシートを検索し、列Bに「X」がある場合は、行全体をコピーして「列B」という名前のワークシートに貼り付けます。次に、B列が完了してペーストされると、列Dが表示されます。列Dに「X」がある場合は、行全体がコピーされ、「列D」というワークシート・タブに貼り付けられます。
ありがとうございます！
アプローチ
私は私の答えの最初のバージョンでこれを含まれている必要があります。
私の解決方法は、オートフィルタに依存します。オートフィルタに をクリア
このアプローチが魅力的であれば、ユーザーが自分が望むフィルターを選択できるようにメニューを作成する別の質問への私の答えを紹介します。
このアプローチが魅力的でない場合は、各フィルタによって残っている可視行を他のワークシートにコピーするという2つ目の解決方法があります。
はじめ
あなたは、私はあなたには、いくつかの経験を持っている意味するために取る「私は書き込みマクロの経験が限られている」と言います。私は正しい説明のレベルがあることを願っています。必要に応じて質問に戻りましょう。
ブックはサーバー上にあると仮定します。私は誰かがマスターワークシートを更新するための書き込みアクセス権を持っている一方で、他の人は読み取り専用コピーを開いて興味のあるサブセットを見ることができると思います。私の前提が正しければ、ワークブックのコピーを取って遊んでください。ワークブックのマスターバージョンを更新している他の人たちの心配はありません。終了したら、あなたのプレイバージョンから最終バージョンのコードをコピーします。
ステップ1
コピープレイバージョン内のモジュールのコードの最初のブロック。下部にはConst WShtMastName As String = "SubSheetSrc"があります。 SubSheetSrcをマスターワークシートの名前で置き換えます。
注：このブロック内のマクロは、再生バージョンであるため、CtrlCreateSubSheetBおよびCreateSubSheetBという名前です。実際のバージョンの名前はCtrlCreateSubSheetとCreateSubSheetです。
実行マクロCtrlCreateSubSheetB。マスターワークシートが表示されますが、列Bに「X」がある行のみが表示されます。メッセージボックスをクリックします。マスターワークシートが表示されますが、列Dには「X」の行のみが表示されます。メッセージボックスをクリックすると、フィルターが消えます。まだそこにいなければ、VBエディタに切り替えます。イミディエイトウィンドウで（それが表示されていない場合Ctrl + Gをクリックして）、あなたが何かのように表示されます。
Rows with X in column 2: $A$1:$G$2,$A$4:$G$5,$A$8:$G$9,$A$11:$G$12,$A$14:$G$14, ...
Rows with X in column 4: $A$1:$G$1,$A$3:$G$3,$A$5:$G$5,$A$7:$G$7,$A$10:$G$10, ...
今すぐマクロCtrlCreateSubSheetBとCreateSubSheetBを下に働きます。あなたはこれらのマクロがどのようにあなたが見た効果を作り出したのかを理解しなければなりません必要に応じてVBヘルプを使用すると、デバッガとF8がマクロをステップダウンして、各ステートメントが何をしているのかを識別します。私はあなたに十分な情報を与えたと信じていますが、必要であれば質問に戻ります。
' Option Explicit means I have to declare every variable. It stops
' spelling mistakes being taken as declarations of new variables.
Option Explicit
' Specify a subroutine with two parameters
Sub CreateSubSheetB(ByVal WShtSrcName As String, ByVal ColSrc As Long)
' This macro applies an AutoFilter based on column ColSrc
' to the worksheet named WShtSrcName
Dim RngVis As Range
With Sheets(WShtSrcName)
If .AutoFilterMode Then
' AutoFilter is on. Cancel current selection before applying
' new one because criteria are additive.
.AutoFilterMode = False
End If
' Make all rows which do not have an X in column ColSrc invisible
.Cells.AutoFilter Field:=ColSrc, Criteria1:="X"
' Set the range RngVis to the union of all visible rows
Set RngVis = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)
End With
' Output a string to the Immediate window.
Debug.Print "Rows with X in column " & ColSrc & ": " & RngVis.Address
End Sub
' A macro to call CreateSubSheetB for different columns
Sub CtrlCreateSubSheetB()
Const WShtMastName As String = "SubSheetSrc"
Dim WShtOrigName As String
' Save the active worksheet
WShtOrigName = ActiveSheet.Name
' Make the master sheet active if it is not already active so
' you can see the different filtered as they are created.
If WShtOrigName <> WShtMastName Then
Sheets(WShtMastName).Activate
End If
' Call CreateSubSheet for column 2 (=B) then column 4 (=D)
Call CreateSubSheetB(WShtMastName, 2)
Call MsgBox("Click to continue", vbOKOnly)
Call CreateSubSheetB(WShtMastName, 4)
Call MsgBox("Click to continue", vbOKOnly)
With Sheets(WShtMastName)
If .AutoFilterMode Then
.AutoFilterMode = False
End If
End With
' Restore the original worksheet if necessary
If WShtOrigName <> WShtMastName Then
Sheets(WShtOrigName).Activate
End If
End Sub
ステップ2
ブックを使用する方法についての私の仮定が正しければ、あなたは多くを必要としない場合があります。 JohnとMaryがそれぞれマスターブックの読み取り専用コピーを開くと、JohnはBフィルタを使用し、MaryはDフィルタを使用することができます。面白そうに聞こえる場合は、copy row data from one sheet to one or more sheets based on values in other cellsへの私の答えを見てください。
ステップ3
あなただけのフィルタを使用してのアイデアが好きで、まだBのデータとDデータのコピーを作成したくない場合は、以下のコードが必要になります。
このブロック内のマクロは、CtrlCreateSubSheetとCreateSubSheetと名前が付けられていますが、上記のバージョンBと大きく異なるわけではありません。
CtrlCreateSubSheetでは、「SubSheetSrc」、「SubSheetB」および「SubSheetD」をこれらのワークシートの名前に置き換える必要があります。他のコントロール列にはCreateSubSheetのコールを追加します。
注：これらのバージョンでは、宛先シートの元の内容は削除されますが、これはユーザーが要求したものではありません。 （1）新しい行を追加するのはもっと複雑で、（2）正しいとは思わないからです。あなたが何を要求したかに何らかの重要性がある場合、戻ってきてコードを更新します。
Option Explicit
Sub CtrlCreateSubSheet()
Const WShtMastName As String = "SubSheetSrc"
' Call CreateSubSheet for column 2 (=B) then column 4 (=D)
Application.ScreenUpdating = False
Call CreateSubSheet(WShtMastName, 2, "SubSheetB")
Call CreateSubSheet(WShtMastName, 4, "SubSheetD")
With Sheets(WShtMastName)
If .AutoFilterMode Then
.AutoFilterMode = False
End If
End With
Application.ScreenUpdating = True
End Sub
Sub CreateSubSheet(ByVal WShtSrcName As String, ByVal ColSrc As Long, _
ByVal WShtDestName As String)
' This macro applies an AutoFilter based on column ColSrc to the worksheet
' named WShtSrcName. It then copies the visible rows to the worksheet
' named WShtDestName
Dim RngVis As Range
Dim WShtOrigName As String
With Sheets(WShtSrcName)
If .AutoFilterMode Then
' AutoFilter is on. Cancel current selection before applying
' new one because criteria are additive.
.AutoFilterMode = False
End If
' Make all rows which do not have an X in column ColSrc invisible
.Cells.AutoFilter Field:=ColSrc, Criteria1:="X"
' Set the range RngVis to the union of all visible cells
Set RngVis = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)
End With
If RngVis Is Nothing Then
' There are no visible rows. Since the header row will be visible even if
' there are no Xs in column ColSrc, I do not believe this block can
' be reached but better to be safe than sorry.
Call MsgBox("There are no rows with an X in column " & ColSrc, vbOKOnly)
Exit Sub
End If
' Copy visible rows to worksheet named WShtDestName
With Sheets(WShtDestName)
' First clear current contents of worksheet named WShtDestName
.Cells.EntireRow.Delete
' Copy column widths to destination sheets
Sheets(WShtSrcName).Rows(1).Copy
.Rows(1).PasteSpecial Paste:=xlPasteColumnWidths
' I do not recall using SpecialPaste column widths before and it did not
' work as I expected. Hunting around the internet I found a link to a
' Microsoft page which gives a workaround. This workaround worked in
' that it copied the column widths but it left row 1 selected. I have
' added the following code partly because I like using FreezePanes and
' partly to unselect row 1.
WShtOrigName = ActiveSheet.Name
If WShtOrigName <> WShtDestName Then
.Activate
End If
.Range("A2").Select
ActiveWindow.FreezePanes = True
If WShtOrigName <> WShtDestName Then
Sheets(WShtOrigName).Activate
End If
' Copy all the visible rows in the Master sheet to the destination sheet.
RngVis.Copy Destination:=.Range("A1")
End With
End Sub
ステップ4
あなたがあなたの満足にマクロをdelevelopedしたら、マスター・バージョンにプレイバージョンからマクロを含むモジュールをコピーする必要があります。モジュールをエクスポートしてインポートすることはできますが、次のように簡単です。
重要なアップデートが完了するたびに、マクロを実行するためにマスターバージョンを更新する担当者を教える必要があります。ショートカットキーを使用するか、ツールバーにマクロを追加して、マクロを使いやすくすることができます。理にかなって
概要
希望すべて。必要に応じて質問してください。単に
より：
Sub Columns()
If WorkSheets("Sheet1").Range("B1") = x Then
WorkSheets("Column B").Range("B2") = WorkSheets("Sheet1").Range("B2:B" & Rows.Count).End(xlup).Row
End if
If WorkSheets("Sheet1").Range("D1") = x Then
WorkSheets("Column D").Range("D2") = WorkSheets("Sheet1").Range("D2:D" & Rows.Count).End(xlup).Row
End if
End Sub
質問。 （1）データをワークシート "列B"に追加するか、最初に削除する既存の行はありますか？ （2） "X"は列Bと列Dの正確な値か、これは異なる値の省略形ですか？ （3）列BとDの両方にXがある場合はどうなりますか？（4）マスターワークシートは変更されませんか？ –
私はなぜ質問を整理するための信用を与えられたのか分かりません。エクセルはすべての努力をしました。 –
（1） "X"が列Bにある行全体がコピーされ、ワークシート "列B"に貼り付けられます。何も削除されません。それは後で行うことができます。 （2）「X」はそれらの列の正確な値です。 （3）列BとDの両方に "X"がある場合は、ワークシート "列B"とワークシート "コロンビアD"の両方にコピーして貼り付けてください。 （4）はい、マスターワークシートは変更されません。ありがとう –