VBAデータ値に応じて、メインシートから別のシートにデータをコピーして貼り付けます

Question

私はMainsheetという名前のメインシートと12枚のシートを毎月1枚持っています。

私Mainsheetは、私は私のmainsheetに反映されたデータをコピーし、それがある月の依存Janの1またはFebにそれを貼り付ける必要がありなど、1月か2月か3月のヶ月間のデータを有することができます。ここで

は

Sub Macro1() 

    Dim i, LastRow 
    LastRow = Sheets("Mainsheet").Range("A" & Rows.Count).End(xlUp).Row 

    For i = 5 To LastRow 

     If Sheets("Mainsheet").Cells(i, "E").Value = "1/20/2017" Then 
      Sheets("Mainsheet").Cells(i, "A").EntireRow.Copy 
      Destination:=Sheets("Jan").Range("A" & Rows.Count).End(xlUp).Offset(1) 
     End If 

    Next i 

End Sub 

私の質問は、データがFebないJanの月のであれば、私はマクロを継続しない方法です..私はこれまで持っているものでしょうか？そして、私はJanの月を指定するだけで、私のコードの1/20/2017のような特定の日付を指定することはできません。

A5:M5の範囲に最後の塗りつぶしされたセルまでの範囲をコピーするには、最後の列が使用されるまでA:5の範囲全体をコピーするのではなく、どうすればよいでしょうか？

Answer 1

よくできました！ を処理するコードを書いた月のシート！

さて、そのチャンクを取り、それをコピーする - そのように下にそれを貼り付けて"Feb"で"Jan"を交換しての... 12回....これを行う：

Private Sub UpdateMonthlyData(ByVal target As Worksheet) 

End Sub 

そして、そこにそれを貼り付け、 Sheets("Jan")をtargetに置き換えてください。あなたがこれを左にしている：

Private Sub UpdateMonthlyData(ByVal target As Worksheet) 
    Dim i, LastRow 
    LastRow = Sheets("Mainsheet").Range("A" & Rows.Count).End(xlUp).Row 
    For i = 5 To LastRow 
     If Sheets("Mainsheet").Cells(i, "E").Value = "1/20/2017" Then 
      Sheets("Mainsheet").Cells(i, "A").EntireRow.Copy 
      Destination:=target.Range("A" & target.Rows.Count).End(xlUp).Offset(1) 
     End If  
    Next i 
End Sub 

は

のは、少しこれをクリーンアップしてみましょう - プロジェクトエクスプローラます（Ctrl + R - Rubberduckとコードエクスプローラが表示されます）にMainsheet (Sheet1)オブジェクトをダブルクリックして、 F4キーを押してプロパティを表示します。 (Name)プロパティをSheet1からMainSheetに変更します。 - VBAは、それにちなんで名付けられたグローバルスコープのオブジェクトを作成し、あなたはそれを使用することができます

Private Sub UpdateMonthlyData(ByVal target As Worksheet) 
    With MainSheet 

     Dim lastRow As Long 
     lastRow = .Range("A" & .Rows.Count).End(xlUp).Row 

     Dim i As Long 
     For i = 5 To lastRow 
      If .Cells(i, "E").Value = #1/20/2017# Then 
       .Cells(i, "A").EntireRow.Copy target.Range("A" & target.Rows.Count).End(xlUp).Offset(1) 
      End If 
     Next 

    End With 
End Sub 

MainSheetはあなたがMainSheetにその(Name)プロパティを設定することにより得た「自由」のグローバルスコープのオブジェクト変数です：今、あなたはこれを行うことができますどこでもを参照するコードでシート。

ここには何がありますか？ monthSheetというパラメータが、コピー先のシートになります。それは、それ自体の別の問題であることを認識しており、それを気にする必要はありません。宣言を使用する場所に近づけ、宣言に明示的な型を与えました。.を使用するものはWith MainSheet命令で修飾され、というオブジェクトのオブジェクトがすべて修飾されます。それは、明示的なワークシートの参照が先行していない場合は、Range、Cells、Rows、Columns、...それらはすべて暗黙的にActiveSheetを参照してください - あなたはではありません任意のシートで作業しているとき：

予選ものが重要ですアクティブなシートを呼び出すと、アクティブなシートを暗黙的に呼び出すと問題が発生します。

私は#の代わり"で#date literal#を同封 - 文字列リテラルのためだという。 #date literal#を使用すると、StringからDateへの暗黙的な変換は避けられます。.Cells(i, "E").ValueはVariant/Dateである必要があります。

次は月パラメータ化し、ワークシートを推測：

Private Sub UpdateMonthlyData(ByVal monthIndex As Long) 
    With MainSheet 

     On Error GoTo ErrHandler 

     Dim name As String 
     name = MonthName(monthIndex, True) 

     Dim target As Worksheet 
     target = ThisWorkbook.Worksheets(name) 

     On Error GoTo 0 'from this point onward any error bubbles up to the caller 

     Dim lastRow As Long 
     lastRow = .Range("A" & .Rows.Count).End(xlUp).Row 

     Dim i As Long 
     For i = 5 To lastRow 
      Dim monthCell As Range 
      monthCell = .Cells(i, "E") 
      If Not IsError(monthCell.Value) Then 
       If CStr(monthCell.Value) = name Then 
        .Cells(i, "A").EntireRow.Copy target.Range("A" & target.Rows.Count).End(xlUp).Offset(1) 
       End If 
      Else 
       Debug.Print "Cell " & monthCell.Address & " contains an error value and cannot be processed." 
      End If 
     Next 

    End With 
    Exit Sub 

ErrHandler: 
    Debug.Print "Could not find a worksheet for month " & monthIndex & "." 
End Sub 

今、呼び出し側は、すべてのシートを処理するために、1から12までのループを実行する必要があります：

For i = 1 To 12 
    UpdateMonthlyData i 
Next 

それはありません私よりもはるかにクリーンになります:)

今、その.Copy操作はまだあなたがしたいことをしません - しかし、悲しいかな、この答えはすでに十分です！がんばろう！