EXCEL vba 批量复制粘贴至指定位置脚本文件

Private Sub CommandButton1_Click() Dim sht As Worksheet, i, d, m, q As Integer, k, l As String, f, R As Variant k = TextBox1.Text l = TextBox2.Text R = TextBox3.Text q = TextBox4.Value Worksheets.Add Before:=Worksheets(1) ActiveSheet.Name = k i = 1 For m = 0 To q - 1 For Each sht In Worksheets n = sht.Name If n = l & CStr(m + 1) Then sht.Select Range(R).Select Selection.Copy Worksheets(k).Select Cells(i, "A").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True i = i + 1 End If Next sht Next m End Sub Private Sub CommandButton2_Click() Me.Hide End Sub Private Sub Frame1_Click() End Sub Private Sub Label1_Click() End Sub Private Sub Label2_Click() End Sub Private Sub Label3_Click() End Sub Private Sub Label4_Click() End Sub Private Sub TextBox1_Change() End Sub Private Sub TextBox2_Change() End Sub Private Sub TextBox3_Change() End Sub Private Sub TextBox4_Change() End Sub