复印最大范围的问题 . 用户选择的范围

我正在尝试编写一个宏，它将要求用户提供工作簿，宏打开工作簿 . 用户选择复制范围并指定在Userform中粘贴数据的工作表 . 宏复制选择范围到指定的工作表 .

但是我遇到了一些问题 .

这是代码：

Public Sub copy_WB()
Application.DisplayAlerts = False
Dim wbk As Workbook, answer As String,lrow as long, lcol as long
Dim UserRange As Range

Prompt = "Select a cell for the output."
Title = "Select a cell"

answer = MsgBox("Would you like to clear all data?", vbYesNo, "Confirmation")
If answer = vbYes Then
    Call clear_all
End If

Set wbk = Get_workbook
If wbk Is Nothing Then
Exit Sub
End If
'   Display the Input Box
    On Error Resume Next
    Set UserRange = Application.InputBox( _
        Prompt:=Prompt, _
        Title:=Title, _
        Type:=8) 'Range selection

'   Was the Input Box canceled?
    If UserRange Is Nothing Then
        MsgBox "Canceled."
        Exit Sub
    Else
        UserRange.Parent.Parent.Activate
        UserRange.Parent.Activate
        lrow = UserRange(UserRange.Count).Row
        lcol = UserRange(UserRange.Count).Columns

        If lrow > 1000000 Or lcol > 15000 Then
        ActiveSheet.UsedRange.Copy
        Else
        UserRange.Copy
        End If

        sh_sel.Show
        Do While IsUserFormLoaded("sh_sel")
            DoEvents
        Loop

        ActiveSheet.Range("A2").PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    End If

ThisWorkbook.Worksheets(3).Range("A1") = lrow
ThisWorkbook.Worksheets(3).Range("A2") = lcol
wbk.Close False
Application.DisplayAlerts = True
End Sub


Private Sub clear_all()
Dim wb As Workbook, shs As Worksheet, lrow As Single, lcol As Single
Set wb = ThisWorkbook

For Each shs In wb.Worksheets

    With shs.UsedRange
        lrow = .Rows(.Rows.Count).Row
        lcol = .Columns(.Columns.Count).Column
    End With
        If Not (lrow = 0 Or lrow = 1) Then
    With shs
        .Range(.Cells(2, 1), .Cells(lrow, lcol)).clear
    End With
        End If
Next shs

End Sub

Function Get_workbook() As Workbook
    Dim wbk As Workbook, pathb As String
    pathb = ThisWorkbook.path
    ChDir pathb


    wbk_name = Application.GetOpenFilename(Title:="Please choose File:", FileFilter:="Excel Files *.xls*(*.xls*),")
        On Error Resume Next
        If Len(Dir(wbk_name)) = 0 Then
        MsgBox "The file was not chosen - macro off."
        Exit Function
        Else
        Set wbk = Workbooks.Open(wbk_name)
        End If
        Set Get_workbook = wbk

End Function

Function IsUserFormLoaded(ByVal UFName As String) As Boolean
    Dim UForm As Object

    IsUserFormLoaded = False
    For Each UForm In VBA.UserForms
        If UForm.Name = UFName Then
            IsUserFormLoaded = True
            Exit For
        End If
    Next
End Function 'IsUserFormLoaded

我面临的第一个问题是当用户按下

位于工作表左上角的按钮以选择整个工作表范围时，它将不会被复制 . 我试图通过添加所选范围的最后一行的条件以某种方式更正它...（请参阅代码） .

但它实际上并不起作用 . 有时它复制范围，有时没有 .

第二个问题：输入框在宏运行时消失 . 不知道为什么它会开心 .

用户格式代码：

Private Sub UserForm_Initialize()
    Dim sh As Worksheet

    For Each sh In ThisWorkbook.Sheets
        ListBox1.AddItem sh.Name
    Next sh

Me.StartUpPosition = 0
  Me.Left = Application.Left + (0.5 * Application.Width) - (0.5 * Me.Width)
  Me.Top = Application.Top + (0.5 * Application.Height) - (0.5 * Me.Height)
    HideTitleBar.HideTitleBar Me
End Sub


Private Sub ListBox1_Click()
    ThisWorkbook.Sheets(ListBox1.Value).Activate
    Unload Me
End Sub

用户表单包含用户选择工作表数据后，当前工作簿中的工作表列表 .