如何用VBA宏依据指定日期复制对应列数据至目标工作表？

This is a perfect use case for a macro—it’ll save you from manually hunting for dates and copying columns every time. Below’s a ready-to-use macro that does exactly what you need, plus explanations to tweak it to your exact setup.

The VBA Code #

Sub CopyWeeklyData()
    Dim targetDate As Date
    Dim headerRange As Range
    Dim dateMatch As Range
    Dim sourceColumn As Integer
    
    ' 1. Grab the target date from the Config sheet (adjust cell reference if needed)
    On Error Resume Next
    targetDate = ThisWorkbook.Sheets("Config").Range("A1").Value
    On Error GoTo 0
    
    ' Check if a valid date was entered
    If IsEmpty(targetDate) Then
        MsgBox "Oops! Please enter a valid date in the Config sheet (currently looking at cell A1).", vbExclamation
        Exit Sub
    End If
    
    ' 2. Define the header row in the Overall sheet (assuming headers are in row 1)
    Set headerRange = ThisWorkbook.Sheets("Overall").Rows(1)
    
    ' 3. Find the matching date in the Overall sheet's headers
    Set dateMatch = headerRange.Find( _
        What:=targetDate, _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        MatchCase:=False _
    )
    
    ' 4. If we found the date, copy the data to This Week
    If Not dateMatch Is Nothing Then
        sourceColumn = dateMatch.Column
        
        ' Copy rows 2-4 from the matched column to B2-B4 in This Week
        ThisWorkbook.Sheets("Overall").Range(Cells(2, sourceColumn), Cells(4, sourceColumn)).Copy _
            Destination:=ThisWorkbook.Sheets("This Week").Range("B2:B4")
            
        MsgBox "Success! Data for " & Format(targetDate, "yyyy-mm-dd") & " has been copied to This Week.", vbInformation
    Else
        ' If date wasn't found, show a warning
        MsgBox "Hmm, couldn't find the date " & Format(targetDate, "yyyy-mm-dd") & " in the Overall sheet's headers. Double-check the date format matches!", vbExclamation
    End If
End Sub

How to Use This Macro #

1. Open your Excel workbook.
2. Press Alt + F11 to open the VBA Editor.
3. Right-click your workbook name in the Project Explorer (left pane) > Insert > Module.
4. Paste the code above into the new module.
5. Adjust any cell references to match your setup:
   • If your date is in Config sheet cell B2 instead of A1, change Range("A1") to Range("B2").
   • If your headers are in row 2 of the Overall sheet, change Rows(1) to Rows(2).
6. Run the macro: Press F5 while in the module, or add a button to your worksheet for one-click access.

Quick Tweaks for Your Needs #

• Copy only values (not formatting): Replace the copy/paste line with this to avoid bringing over cell styles:

  ThisWorkbook.Sheets("This Week").Range("B2:B4").Value = ThisWorkbook.Sheets("Overall").Range(Cells(2, sourceColumn), Cells(4, sourceColumn)).Value
  

• Date format mismatches: If the macro can’t find the date even though it exists, ensure the date format in Config matches the format used in Overall’s headers. You can also change LookAt:=xlWhole to LookAt:=xlPart if partial date matches are acceptable (though exact matches are safer).
• Expand the data range: If you need to copy more than rows 2-4, adjust the Cells(2, sourceColumn), Cells(4, sourceColumn) part (e.g., Cells(2, sourceColumn), Cells(10, sourceColumn) for rows 2-10).

Always test the macro on a copy of your workbook first to make sure it works as expected!

内容的提问来源于stack exchange，提问作者Nath Stanley