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

例えば、特定の日付に基づいて行全体をコピーし、別のワークシートに貼り付けたいとします。この作業をExcelで効率的に行う良い方法はありますか？

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

日付が今日より大きい場合に行をコピーし、別のワークシートに貼り付ける

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

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

1. ALT + F11キーを押し続けて、Microsoft Visual Basic for Applicationsウィンドウを開きます。

2. 挿入 > モジュールをクリックし、モジュールウィンドウに次のコードを貼り付けます。

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コードを使用します。

次のVBAコードが役立つかもしれません：

1. ALT + F11キーを押し続けて、Microsoft Visual Basic for Applicationsウィンドウを開きます。

2. 挿入 > モジュールをクリックし、モジュールウィンドウに次のコードを貼り付けます。

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

注釈: 上記のコードでは、条件を変更できます。例えば、今日より小さい日付や日数を必要に応じて変更できます。If TypeName(xVal) = "Date" And (xVal <> "") And (xVal >= Date And (xVal < Date +5)) Then スクリプトコード。

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

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

5. OKボタンをクリックすると、今日から5日以上の日付の行が新しいワークシートにコピーされ、貼り付けられます。以下のスクリーンショットを参照してください：