Private Sub cmdBtn_Click()
    
   ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '判断名为sheet2的表是否存在，不存在则创建
    Dim sheet2Exist As Boolean
    sheet2Exist = funSheetExist("Sheet2")
    If Not (sheet2Exist) Then
        Worksheets.Add Count:=1, after:=Sheets(1)
      
        ThisWorkbook.ActiveSheet.Name = "Sheet2"
        
    End If
    
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    Dim totalRow As Integer
    totalRow = Sheet1.UsedRange.Rows.Count   
    
    For i = 1 To totalRow - 2
    
        Worksheets("Sheet1").Activate
        Worksheets("Sheet1").Select
        Rows("2:2").Select
        Selection.Copy
        
        Worksheets("sheet2").Activate
        Worksheets("sheet2").Select
        Worksheets("sheet2").Rows(i * 2 - 1 & ":" & i * 2 - 1).Select
        ActiveSheet.Paste
        
        Worksheets("Sheet1").Activate
        Worksheets("Sheet1").Select
        Rows(i + 2 & ":" & i + 2).Select
        Selection.Copy
        
        Worksheets("sheet2").Activate
        Worksheets("sheet2").Select
        Worksheets("sheet2").Rows(i * 2 & ":" & i * 2).Select
        ActiveSheet.Paste
      
    Next
    

    
End Sub


Function funSheetExist(strSheetName As String) As Boolean

    Dim existFlag As Boolean
    Dim nNumOfSheets    As Integer
    existFlag = False
    nNumOfSheets = Worksheets.Count
    For i = 1 To nNumOfSheets
        If Worksheets(i).Name = strSheetName Then existFlag = True
    Next
    funSheetExist = existFlag
    
End Function


这个执行效率太低了,原表有100行时,执行时间大约为1分钟,请问有什么方法提高效率.