与最大范围的副本问题。 用户select的范围

我正试图写一个macros，它会要求用户提供工作簿，macros打开工作簿。 用户select要复制的范围，并指定在“用户窗体”中粘贴数据的工作表。 将选定范围的macros复制到指定的工作表。

但是我面临着一些问题。

这是代码：

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 

我面临的第一个问题是用户按下时 位于工作表左上angular的button用于select整个工作表范围，不会被复制。 我试图通过添加所选范围的最后一行的条件大于…（请查看代码）以某种方式纠正它。

但它并不实际工作。 有时它复制范围，有时不。

第二个问题：macros运行时inputbox消失。 不知道为什么它happans。

用户表单代码：

 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 

用户表单包含当前工作簿中的表单列表，用户select表单数据后将被粘贴。