實例21-刪除工作簿中多個工作表，實例22-提取多個工作表合并為一個工作表
實例21-刪除工作簿中多個工作表
Dim wbname As String
Private Sub CommandButton獲取_Click()
'獲取工作簿中包含的工作表
With ThisWorkbook.Worksheets("名稱列表")? '清除原列表數(shù)據(jù)
? ? .Columns(1).ClearFormats
? ? .Columns(1).ClearContents
? ? .Columns(2).ClearFormats
? ? .Columns(2).ClearContents
End With
With ThisWorkbook.Worksheets("操作界面")
If .Cells(2, "C").Value <> "" Then
? ? wbname = .Cells(2, "C").Value
Else
MsgBox "請輸入工作簿名稱（包含擴(kuò)展名）"
Exit Sub
End If
End With
Dim i As Integer
For i = 1 To Workbooks(wbname).Worksheets.Count
? ? ThisWorkbook.Worksheets("名稱列表").Cells(i, 1).Value = Workbooks(wbname).Worksheets(i).Name
Next i
ThisWorkbook.Worksheets("名稱列表").Activate
End Sub
Private Sub CommandButton刪除_Click()
Application.DisplayAlerts = False
With ThisWorkbook.Worksheets("操作界面")
If .Cells(2, "C").Value <> "" Then
? ? wbname = .Cells(2, "C").Value
Else
MsgBox "請輸入工作簿名稱（包含擴(kuò)展名）"
Exit Sub
End If
End With
With ThisWorkbook.Worksheets("名稱列表")
? ? Dim i As Long
? ? Dim imax As Long
? ? imax = .Cells(1000000, 1).End(xlUp).Row
? ? For i = 1 To imax
? ? ? ? If .Cells(i, 1).Value <> "" And .Cells(i, 2).Value <> "" Then
? ? ? ? ? ? Workbooks(wbname).Worksheets(CStr(.Cells(i, 1).Value)).Delete
? ? ? ? End If
? ? Next i
? ? Workbooks(wbname).Save
? ? MsgBox "處理完成"
End With
Application.DisplayAlerts = True
End Sub
實例22-提取多個工作表合并為一個工作表
Dim wbname As String
Private Sub CommandButton獲取_Click()
'獲取工作簿中包含的工作表
With ThisWorkbook.Worksheets("名稱列表")? '清除原列表數(shù)據(jù)
? ? .Columns(1).ClearFormats
? ? .Columns(1).ClearContents
End With
With ThisWorkbook.Worksheets("操作界面")
If .Cells(2, "C").Value <> "" Then
? ? wbname = .Cells(2, "C").Value
Else
MsgBox "請輸入工作簿名稱（包含擴(kuò)展名）"
Exit Sub
End If
End With
Dim i As Integer
For i = 1 To Workbooks(wbname).Worksheets.Count
? ? ThisWorkbook.Worksheets("名稱列表").Cells(i, 1).Value = Workbooks(wbname).Worksheets(i).Name
Next i
ThisWorkbook.Worksheets("名稱列表").Activate
End Sub
Private Sub CommandButton提取_Click()
With ThisWorkbook.Worksheets("提取結(jié)果")? '清除原列表數(shù)據(jù)
? ? .UsedRange.ClearFormats
? ? .UsedRange.ClearContents
End With
With ThisWorkbook.Worksheets("操作界面")
If .Cells(2, "C").Value <> "" Then
? ? wbname = .Cells(2, "C").Value
Else
MsgBox "請輸入工作簿名稱（包含擴(kuò)展名）"
Exit Sub
End If
Dim extractrange As String
If .Cells(6, "C").Value <> "" Then
? ? extractrange = .Cells(6, "C").Value
Else
MsgBox "請輸入提取區(qū)域地址"
Exit Sub
End If
End With
Dim addrow As Long
With ThisWorkbook.Worksheets("名稱列表")
? ? Dim i As Long
? ? Dim imax As Long
? ? imax = .Cells(1000000, 1).End(xlUp).Row
? ? For i = 1 To imax
? ? ? ? If .Cells(i, 1).Value <> "" Then
? ? ? ? With ThisWorkbook.Worksheets("提取結(jié)果")
? ? ? ? ? ? addrow = .UsedRange.Cells(.UsedRange.Cells.Count).Row + 2
? ? ? ? End With
? ? ? ? ? ? Workbooks(wbname).Worksheets(CStr(.Cells(i, 1).Value)).Range(extractrange).Copy ThisWorkbook.Worksheets("提取結(jié)果").Cells(addrow, 1)
? ? ? ? End If
? ? Next i
? ? MsgBox "處理完成"
End With
ThisWorkbook.Worksheets("提取結(jié)果").Activate
End Sub
