如题！求助高手写个简单代码高效率

在Excel文件中复制内容，打开狐表表格进行贴粘，能够自动对应列进行贴粘。

贴粘按钮，代码如下：

Dim vWIN1v,vTB1v,vTB2v,Values1(),Values2(),s As String
vWIN1v = "窗口48"
vTB1v = vWIN1v & "_Table1" \'临时表
vTB2v = CurrentTable.Name \'粘贴表
Dim ii,n As Integer
If Tables(vTB2v).AllowEdit Andalso ClipBoard.ContainsText Then \'判断字符串,判断粘贴表可编辑
    For Each cl As Col In Tables(vTB2v).Cols
        If cl.Visible Andalso cl.AllowEdit Then
            ii = 1
        End If
    Next
    If ii = 1 Then \'粘贴的目标表必须有可见列并且可编辑列
        s = ClipBoard.GetText() \'获取总的字符串
        n = s.Length - s.Replace(chr(13),"").Length
        If n > 1 Then \'判断复制的记录必须大于1
            Values1 = s.Split(chr(13)) \'拆为复制的内容为一行一行记录
            Values2 = Values1(0).Split(vbTab) \'提取复制的内容的列数
            Forms(vWIN1v).Show()
            DataTables(vTB1v).DataRows.Clear() \'清空记录
            Tables(vTB1v).AllowEdit = True \'可编辑表
            Application.DoEvents
            If Values2.Length > Tables(vTB1v).Cols.Count Then \'临时表的列数不足进行添加列
                For i As Integer = Tables(vTB1v).Cols.Count + 1 To Values2.Length
                    DataTables(vTB1v).DataCols.Add("第" & i & "列",Gettype(String),255)
                Next
            End If
            Tables(vTB1v).AddNew(n) \'临时表添加行
            Tables(vTB1v).Select(0,0) \'临时表选定第一行第一列的单元格
            Tables(vTB1v).Focus \'移动焦点到临时表
            Tables(vTB1v).StopRedraw \'关闭绘制
            Syscmd.Edit.Paste() \'粘贴到临时表
            Tables(vTB1v).ResumeRedraw \'恢复绘制
            Application.DoEvents
            If Tables(vTB1v).Rows.Count > 1 Then \'临时表的记录大于1行
                Dim dr As Row = Tables(vTB1v).Rows(0) \'提取临时表的第一行记录
                For Each cl1 As DataCol In DataTables(vTB1v).DataCols \'临时表修改标题
                    If dr(cl1.Name) IsNot Nothing Andalso dr(cl1.Name) <> "" Then \'临时表的单元格不为空
                        For Each cl2 As Col In Tables(vTB2v).Cols \'粘贴表相同标题
                            If cl2.AllowEdit Andalso cl2.Visible Then \'粘贴表的可编辑列与可显示列
                                If cl2.Caption IsNot Nothing Andalso cl2.Caption <> "" Then \'标题不为空
                                    If cl2.Caption = dr(cl1.Name) Then
                                        cl1.Caption = cl2.Name
                                    End If
                                Else \'标题为空
                                    If cl2.Name = dr(cl1.Name) Then
                                        cl1.Caption = cl2.Name
                                    End If
                                End If
                            End If
                        Next
                    End If
                Next
                DataTables(vTB1v).BuildHeader
                Tables(vTB1v).Rows.Delete(0)
                Dim drnew As Row
                For Each dr1 As Row In Tables(vTB1v).Rows \'循环临时表的所有行
                    drnew = Tables(vTB2v).AddNew()
                    For Each cl1 As DataCol In DataTables(vTB1v).DataCols \'循环临时表的所有标题
                        If cl1.Caption IsNot Nothing Andalso cl1.Caption <> "" Then \'临时表标题不为空
                            drnew(cl1.Caption) = dr1(cl1.Name)
                        End If \'临时表标题不为空
                    Next \'循环临时表的所有标题
                Next \'循环临时表的所有行
            End If
            Application.DoEvents
            Forms(vWIN1v).Close()
        Else
            MessageBox.Show("复制的记录必须大于1,请检查!!!","提示")
        End If
    Else
        MessageBox.Show("粘贴的目标表必须有可见列并且是可以编辑列,请检查!!!","提示")
    End If
Else
    MessageBox.Show("粘贴的目标表必须是可编辑,并且粘贴的内容必须是数据,请检查!!!","提示")
End If