实例19提取多行多列Excel表格

　　实例19-间隔指定行数插入空行
　　Private Sub CommandButton处理_Click()
　　＂判断工作簿名，工作表名不为空
　　With ThisWorkbook.Worksheets(＂操作界面＂)
　　If Trim(.Cells(2, ＂C＂).Value) = ＂＂ Or Trim(.Cells(6, ＂C＂).Value) = ＂＂ Or Trim(.Cells(10, ＂C＂).Value) = ＂＂ _
　　Or Trim(.Cells(10, ＂D＂).Value) = ＂＂ Or Trim(.Cells(14, ＂C＂).Value) = ＂＂ Then
　　MsgBox ＂参数不能为空＂
　　Exit Sub
　　End If
　　＂On Error GoTo 处理出错
　　＂定义变量
　　Dim wbname As String
　　Dim shname As String
　　wbname = Trim(.Cells(2, ＂C＂).Value)
　　shname = Trim(.Cells(6, ＂C＂).Value)
　　Dim splitrow As Long
　　Dim startnum As Long
　　Dim stopnum As Long
　　splitrow = Trim(.Cells(14, ＂C＂).Value)
　　startnum = Trim(.Cells(10, ＂C＂).Value)
　　stopnum = Trim(.Cells(10, ＂D＂).Value)
　　End With
　　＂处理表格
　　With Workbooks(wbname).Worksheets(shname)
　　Dim i
　　For i = stopnum To startnum Step splitrow * (-1)
　　.Rows(i).Insert
　　Next i
　　End With
　　Workbooks(wbname).Save
　　MsgBox ＂处理完成＂
　　Workbooks(wbname).Activate
　　ActiveWindow.WindowState = xlMaximized
　　Workbooks(wbname).Worksheets(shname).Activate
　　Workbooks(wbname).Worksheets(shname).Cells(1, 1).Select
　　Exit Sub
　　处理出错:
　　MsgBox Err.Description
　　End Sub
　　实例20-提取多行多列
　　Private Sub CommandButton提取列_Click()
　　＂判断工作簿名，工作表名不为空
　　With ThisWorkbook.Worksheets(＂操作界面＂)
　　If Trim(.Cells(2, ＂C＂).Value) = ＂＂ Or Trim(.Cells(6, ＂C＂).Value) = ＂＂ Then
　　MsgBox ＂参数不能为空＂
　　Exit Sub
　　End If
　　＂On Error GoTo 处理出错
　　＂定义变量
　　Dim wbname As String
　　Dim shname As String
　　wbname = Trim(.Cells(2, ＂C＂).Value)
　　shname = Trim(.Cells(6, ＂C＂).Value)
　　End With
　　＂清除提取结果
　　With ThisWorkbook.Worksheets(＂提取结果＂)
　　.UsedRange.ClearFormats
　　.UsedRange.ClearContents
　　End With
　　＂处理表格
　　With Workbooks(wbname).Worksheets(shname)
　　＂循环
　　Dim i, icount
　　Dim imax As Long
　　imax = ThisWorkbook.Worksheets(＂提取行列号＂).Cells(1, 10000).End(xlToLeft).Column
　　icount = 1
　　For i = 1 To imax
　　If ThisWorkbook.Worksheets(＂提取行列号＂).Cells(1, i) <> ＂＂ Then
　　.Columns(CLng(ThisWorkbook.Worksheets(＂提取行列号＂).Cells(1, i))).Copy ThisWorkbook.Worksheets(＂提取结果＂).Columns(icount)
　　icount = icount + 1
　　End If
　　Next i
　　End With
　　MsgBox ＂处理完成＂
　　ThisWorkbook.Worksheets(＂提取结果＂).Activate
　　Exit Sub
　　处理出错:
　　MsgBox Err.Description
　　End Sub
　　Private Sub CommandButton提取行_Click()
　　＂判断工作簿名，工作表名不为空
　　With ThisWorkbook.Worksheets(＂操作界面＂)
　　If Trim(.Cells(2, ＂C＂).Value) = ＂＂ Or Trim(.Cells(6, ＂C＂).Value) = ＂＂ Then
　　MsgBox ＂参数不能为空＂
　　Exit Sub
　　End If
　　＂On Error GoTo 处理出错
　　＂定义变量
　　Dim wbname As String
　　Dim shname As String
　　wbname = Trim(.Cells(2, ＂C＂).Value)
　　shname = Trim(.Cells(6, ＂C＂).Value)
　　End With
　　＂清除提取结果
　　With ThisWorkbook.Worksheets(＂提取结果＂)
　　.UsedRange.ClearFormats
　　.UsedRange.ClearContents
　　End With
　　＂处理表格
　　With Workbooks(wbname).Worksheets(shname)
　　＂循环
　　Dim i, icount
　　Dim imax As Long
　　imax = ThisWorkbook.Worksheets(＂提取行列号＂).Cells(1000000, 1).End(xlUp).Row
　　icount = 1
　　For i = 1 To imax
　　If ThisWorkbook.Worksheets(＂提取行列号＂).Cells(i, 1) <> ＂＂ Then
　　.Rows(CLng(ThisWorkbook.Worksheets(＂提取行列号＂).Cells(i, 1))).Copy ThisWorkbook.Worksheets(＂提取结果＂).Rows(icount)
　　icount = icount + 1
　　End If
　　Next i
　　End With
　　MsgBox ＂处理完成＂
　　ThisWorkbook.Worksheets(＂提取结果＂).Activate
　　Exit Sub
　　处理出错:
　　MsgBox Err.Description
　　End Sub