Excelで日付に基づいて行をコピーして別のシートに貼り付ける方法は？ 

ある範囲のデータがあるとすると、特定の日付に基づいて行全体をコピーしてから、別のシートに貼り付けたいと思います。 Excelでこの仕事に対処するための良いアイデアはありますか？

行をコピーして、今日の日付に基づいて別のシートに貼り付けます

日付が今日よりも大きい場合は、行をコピーして別のシートに貼り付けます

行をコピーして、今日の日付に基づいて別のシートに貼り付けます

日付が今日の場合に行をコピーする必要がある場合は、次のVBAコードを適用してください。

1。 を押し続けます Alt + F11 キーを押して アプリケーション向け Microsoft Visual Basic 窓。

2に設定します。 OK をクリックします。 インセット > モジュール、モジュールウィンドウに次のコードを貼り付けます。

VBAコード：今日の日付に基づいて行をコピーして貼り付けます。

Sub CopyRow()
'Updateby Extendoffice
    Dim xRgS As Range, xRgD As Range, xCell As Range
    Dim I As Long, xCol As Long, J As Long
    Dim xVal As Variant
    On Error Resume Next
    Set xRgS = Application.InputBox("Please select the date column:", "KuTools For Excel", Selection.Address, , , , , 8)
    If xRgS Is Nothing Then Exit Sub
    Set xRgD = Application.InputBox("Please select a destination cell:", "KuTools For Excel", , , , , , 8)
    If xRgD Is Nothing Then Exit Sub
    xCol = xRgS.Rows.Count
    Set xRgS = xRgS(1)
    Application.CutCopyMode = False
    J = 0
    For I = 1 To xCol
        Set xCell = xRgS.Offset(I - 1, 0)
        xVal = xCell.Value
        If TypeName(xVal) = "Date" And (xVal <> "") And (xVal = Date) Then
            xCell.EntireRow.Copy xRgD.Offset(J, 0)
            J = J + 1
        End If
    Next
    Application.CutCopyMode = True
End Sub

3。 上記のコードを貼り付けた後、を押してください F5 このコードを実行するためのキーを押すと、行をコピーする日付列を選択するように促すプロンプトボックスが表示されます。スクリーンショットを参照してください。

4。 次に、をクリックします OK ボタンをクリックし、別のプロンプトボックスで、結果を出力する別のシートのセルを選択します。スクリーンショットを参照してください。

5。 そして、 OK ボタンをクリックすると、今日の日付の行が新しいシートに一度に貼り付けられます。スクリーンショットを参照してください。

日付が今日よりも大きい場合は、行をコピーして別のシートに貼り付けます

日付が今日以降の行をコピーして貼り付けるには、たとえば、日付が今日から5日以上の場合は、行をコピーして別のシートに貼り付けます。

次のVBAコードはあなたに有利かもしれません：

1。 を押し続けます Alt + F11 キーを押して アプリケーション向け Microsoft Visual Basic 窓。

2に設定します。 OK をクリックします。 インセット > モジュール、モジュールウィンドウに次のコードを貼り付けます。

VBAコード：日付が今日よりも大きい場合は、行をコピーして貼り付けます。

Sub CopyRow()
'Updateby Extentoffice
    Dim xRgS As Range, xRgD As Range, xCell As Range
    Dim I As Long, xCol As Long, J As Long
    Dim xVal As Variant
    On Error Resume Next
    Set xRgS = Application.InputBox("Please select the date column:", "KuTools For Excel", Selection.Address, , , , , 8)
    If xRgS Is Nothing Then Exit Sub
    Set xRgD = Application.InputBox("Please select a destination cell:", "KuTools For Excel", , , , , , 8)
    If xRgD Is Nothing Then Exit Sub
    xCol = xRgS.Rows.Count
    Set xRgS = xRgS(1)
    Application.CutCopyMode = False
    J = 0
    For I = 1 To xCol
        Set xCell = xRgS.Offset(I - 1, 0)
        xVal = xCell.Value
        If TypeName(xVal) = "Date" And (xVal <> "") And (xVal >= Date And (xVal < Date + 5)) Then
            xCell.EntireRow.Copy xRgD.Offset(J, 0)
            J = J + 1
        End If
    Next
    Application.CutCopyMode = True
End Sub

Note：上記のコードでは、今日より少ない日数や必要に応じて日数などの基準を変更できます。 If TypeName（xVal）= "Date" And（xVal <> ""）And（xVal> = Date And（xVal <Date + 5））Then スクリプトコード。

3。 次に、 F5 このコードを実行するためのキー。プロンプトボックスで、使用するデータ列を選択してください。スクリーンショットを参照してください。

4。 次に、をクリックします OK ボタンをクリックし、別のプロンプトボックスで、結果を出力する別のシートのセルを選択します。スクリーンショットを参照してください。

5。 クリック OK ボタンをクリックすると、次のスクリーンショットに示すように、日付が今日から5日以上の行がコピーされ、新しいシートに貼り付けられます。