如何修改Excel VBA代码添加InputBox让用户自主选择粘贴目标范围

修改思路 #

使用Excel内置的Application.InputBox（设置Type参数为8）实现鼠标点选粘贴目标位置，比手动输入单元格地址容错性更高，同时新增取消操作的异常处理，避免用户取消后程序报错。

修改后完整代码 #

Sub IMPORT_DATA()
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Dim TargetRng As Range ' 新增：存储用户选择的粘贴目标区域
    Application.ScreenUpdating = False
    FileToOpen = Application.GetOpenFilename(Title:="浏览需要导入的文件", FileFilter:="Excel Files(*.xlsx),*xlsx")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets("NELT report").Range("R7:R14").Copy
        
        ' 新增：弹出选择框让用户选粘贴位置
        On Error Resume Next ' 处理用户点取消的情况
        Set TargetRng = Application.InputBox("请选择粘贴目标的起始单元格（仅需点左上角第一个单元格即可）", "选择粘贴位置", Type:=8)
        On Error GoTo 0
        
        ' 判断用户是否取消选择
        If TargetRng Is Nothing Then
            OpenBook.Close False
            GoTo Cleanup ' 直接跳转到结束部分
        End If
        
        ' 粘贴到用户选择的位置的左上角单元格
        ThisWorkbook.Worksheets("Dispatch Monthly NETO").Range(TargetRng.Cells(1, 1).Address).PasteSpecial xlPasteValues
        OpenBook.Close False
        
        ' 修改：给用户选择的目标位置往下8行区域上色，和原逻辑保持一致
        TargetRng.Cells(1, 1).Resize(8, 1).Interior.Color = RGB(255, 242, 204)
    End If
Cleanup:
    Application.ScreenUpdating = True
End Sub

核心修改点说明 #

• 新增了TargetRng变量存储用户选择的粘贴目标位置
• 用Application.InputBox的Type=8参数实现区域点选功能，用户可以直接用鼠标在表格里选位置，不需要手动输入单元格地址
• 新增了取消操作判断：用户点输入框的取消按钮时，程序会正常关闭打开的源文件，不会报错也不会执行后续粘贴操作
• 粘贴时自动取用户选择区域的左上角单元格，避免用户框选多格导致的粘贴错位
• 背景色填充逻辑同步适配用户选择的位置，自动扩展8行填充指定颜色

注意事项 #

• 选择粘贴位置时仅需要点击目标区域的左上角第一个单元格即可，不需要手动框选8行
• 代码保留了原有的所有功能逻辑，仅调整了粘贴位置的指定方式

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