合并VBA中的两个If语句，实现单次选择工作簿复制多工作表

直接使用下面修改后的代码，仅需一次选择源工作簿，就能完成两个工作表的数据复制：

Sub Get_Data_From_File()
    Dim Filetoopen As Variant
    Dim openbook As Workbook
    
    ' 关闭屏幕刷新提升运行效率
    Application.ScreenUpdating = False
    
    ' 仅执行一次源工作簿选择操作
    Filetoopen = Application.GetOpenFilename(Title:="browse for workbook", filefilter:="excel files(*.xlsx*),*xlsx*")
    If Filetoopen <> False Then
        Set openbook = Application.Workbooks.Open(Filetoopen)
        
        ' 复制Sheet1数据到目标工作簿Sheet1的A1位置
        openbook.Sheets("sheet1").Range("A1:K1200").Copy
        ThisWorkbook.Worksheets("Sheet1").Range("A1").PasteSpecial xlPasteValues
        
        ' 复制Sheet2数据到目标工作簿Sheet1的M10位置
        openbook.Sheets("sheet2").Range("A1:K1200").Copy
        ThisWorkbook.Worksheets("Sheet1").Range("M10").PasteSpecial xlPasteValues
        
        openbook.Close False
    End If
    
    ' 恢复屏幕刷新
    Application.ScreenUpdating = True
End Sub

关键修改点说明 #

• 移除了重复的文件选择弹窗调用，只执行一次Application.GetOpenFilename，避免重复选择操作
• 将两个工作表的复制粘贴逻辑合并到同一个工作簿打开流程中，打开一次源工作簿即可完成所有数据复制，无需反复打开关闭
• 调整了屏幕刷新设置的位置，仅在代码开头关闭、结尾恢复，减少无效操作同时提升运行速度
• 完全保留了你原代码中数据复制的目标位置和范围，确保功能与原需求一致

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