求助：修改Excel宏实现输入内容自动向下填充3行（保留格式）

没问题，我帮你调整这个宏的功能！核心要做的就是在用户输入内容后，把这个单元格的内容和格式一起向下覆盖3行（算上输入的那一行，总共是4行内容）。

核心修改思路 #

• 先获取用户输入并赋值到目标起始单元格
• 把起始单元格扩展为4行1列的区域（起始行+下面3行）
• 使用AutoFill方法同时复制内容和格式，完美保留原有样式

修改后的完整代码示例 #

假设你的原有粘贴逻辑已经写好，这里是整合后的代码：

Sub PasteAndInputWithFill()
    ' --- 你的原有粘贴数据代码，请保持不变 ---
    ' 示例粘贴代码（根据你的实际场景调整）：
    ' Sheets("数据源").Range("A1:D10").Copy
    ' ActiveSheet.Range("A1").PasteSpecial xlPasteAll ' 粘贴到活动工作表的A1开始位置
    ' Application.CutCopyMode = False ' 清除剪贴板的复制状态
    
    ' 获取用户输入内容
    Dim userInput As String
    userInput = InputBox("请在新粘贴区域A列第一行输入内容：")
    
    ' 定义新粘贴区域A列的第一行（请根据你的实际粘贴位置修改这个单元格）
    Dim startCell As Range
    Set startCell = ActiveSheet.Range("A1")
    
    ' 给起始单元格赋值
    startCell.Value = userInput
    
    ' 向下填充3行（包含起始行，共4行），同时保留格式
    startCell.Resize(4, 1).AutoFill Destination:=startCell.Resize(4, 1), Type:=xlFillDefault
End Sub

关键代码解释 #

• Resize(4, 1)：把单个单元格扩展成4行1列的区域，刚好覆盖输入行+下方3行
• AutoFill + xlFillDefault：这个参数会自动复制单元格的内容、格式、公式（如果有的话），完全满足你保留原有格式的要求
• 如果你的粘贴位置不是固定的A1，可以用自动定位的方式（比如找当前工作表A列的最后一行或者新粘贴区域的首行），下面是更灵活的版本：

自动定位起始行的灵活版本 #

这个版本不需要手动指定起始单元格，会自动找到新粘贴区域A列的第一行：

Sub PasteAndInputWithFill_Automatic()
    ' --- 你的原有粘贴数据代码，请保持不变 ---
    ' 示例粘贴代码（追加到工作表末尾）：
    ' Dim pasteStartRow As Long
    ' pasteStartRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
    ' Sheets("数据源").Range("A1:D10").Copy
    ' ActiveSheet.Range("A" & pasteStartRow).PasteSpecial xlPasteAll
    ' Application.CutCopyMode = False
    
    ' 自动定位新粘贴区域A列的第一行（这里假设粘贴是追加到末尾，根据你的实际情况调整）
    Dim startCell As Range
    Set startCell = ActiveSheet.Cells(ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row, 1)
    
    ' 获取用户输入
    Dim userInput As String
    userInput = InputBox("请在新粘贴区域A列第一行输入内容：")
    
    ' 赋值并填充
    startCell.Value = userInput
    startCell.Resize(4, 1).AutoFill Destination:=startCell.Resize(4, 1), Type:=xlFillDefault
End Sub

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