嘿，我来帮你搞定这个VBA需求！之前用For循环没成功，大概率是在单元格匹配或者数据提取的环节踩了小坑，我给你整理了一套完整的实现方案，你可以直接参考修改：

• 先获取用户输入的YYYY-MM格式日期，做格式校验避免非法输入
• 在当前工作表中精准定位目标日期单元格（兼容文本和日期两种格式，这是很多人容易忽略的点）
• 根据输入日期拼接对应工作簿的路径，先检查文件是否存在
• 打开目标工作簿提取数据，填充到找到的单元格所在列的下方
• 最后关闭源工作簿，释放资源

Sub FillDataByTargetDate()
    Dim targetDate As String
    Dim currentWS As Worksheet
    Dim targetCell As Range
    Dim sourceWorkbook As Workbook
    Dim sourceWorksheet As Worksheet
    Dim sourceLastRow As Long
    Dim fillStartRow As Long
    
    ' 1. 获取用户输入并校验格式
    targetDate = InputBox("请输入YYYY-MM格式的日期（例如：2019-04）", "日期输入")
    If Not targetDate Like "####-##" Then
        MsgBox "格式不对哦！请按照YYYY-MM的格式输入~", vbExclamation
        Exit Sub
    End If
    
    ' 2. 指定要操作的工作表（可根据实际修改，比如ThisWorkbook.Worksheets("数据汇总")）
    Set currentWS = ActiveSheet
    
    ' 3. 查找目标日期单元格：兼容文本格式和日期值格式
    On Error Resume Next
    ' 先按文本内容查找
    Set targetCell = currentWS.Cells.Find(What:=targetDate, LookIn:=xlValues, LookAt:=xlWhole)
    ' 如果没找到，尝试把输入转为日期值再查找（因为Excel日期实际是数值）
    If targetCell Is Nothing Then
        Dim dateSerialValue As Date
        dateSerialValue = DateSerial(Left(targetDate, 4), Mid(targetDate, 6, 2), 1)
        Set targetCell = currentWS.Cells.Find(What:=dateSerialValue, LookIn:=xlValues, LookAt:=xlWhole)
    End If
    On Error GoTo 0
    
    ' 检查是否找到目标单元格
    If targetCell Is Nothing Then
        MsgBox "没找到包含" & targetDate & "的单元格呢！", vbInformation
        Exit Sub
    End If
    
    ' 4. 拼接源工作簿路径（请根据你的实际文件路径修改！）
    Dim sourceFilePath As String
    sourceFilePath = "C:\你的数据存储文件夹\" & targetDate & ".xlsx" ' 假设文件命名为2019-04.xlsx
    
    ' 检查文件是否存在
    If Dir(sourceFilePath) = "" Then
        MsgBox "对应日期的文件不存在：" & sourceFilePath, vbCritical
        Exit Sub
    End If
    
    ' 5. 提取并填充数据
    Application.ScreenUpdating = False ' 关闭屏幕刷新，提升运行速度
    Set sourceWorkbook = Workbooks.Open(sourceFilePath, ReadOnly:=True)
    Set sourceWorksheet = sourceWorkbook.Worksheets("数据源") ' 修改为源文件的工作表名称
    
    ' 获取源数据的最后一行（假设数据在A列，按需修改列号）
    sourceLastRow = sourceWorksheet.Cells(sourceWorksheet.Rows.Count, "A").End(xlUp).Row
    
    ' 确定填充起始行：目标单元格的下一行
    fillStartRow = targetCell.Row + 1
    
    ' 复制源数据到目标列（这里复制A列第2行到最后一行，按需修改范围）
    sourceWorksheet.Range("A2:A" & sourceLastRow).Copy Destination:=currentWS.Cells(fillStartRow, targetCell.Column)
    
    ' 6. 收尾：关闭源工作簿，恢复屏幕刷新
    sourceWorkbook.Close SaveChanges:=False
    Application.ScreenUpdating = True
    
    MsgBox "数据填充完成啦！", vbInformation
End Sub

• 日期匹配问题：Excel里的日期可能是文本格式（直接输入的"2019-04"）或者日期值格式（实际是数值，只是显示为YYYY-MM），代码里做了两种情况的查找，避免漏找
• 文件路径修改：一定要把sourceFilePath里的路径改成你实际存储日期文件的文件夹，文件名也要和你的实际命名一致（比如如果你的文件是"2019年04月数据.xlsx"，就要调整拼接规则）
• 数据范围调整：如果源数据不在A列，或者需要提取多列数据，修改sourceWorksheet.Range("A2:A" & sourceLastRow)这部分的范围即可
• 工作表指定：如果不是操作当前激活的工作表，把currentWS = ActiveSheet改成currentWS = ThisWorkbook.Worksheets("你的工作表名称")

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