请问一下我这个VBA代码怎么同时在三个工作表运行？
需要修改现有代码，分别对三个表进行选择和执行三次，如果代码里面有指定表的语句，全部都要取消，让使用默认的AcriveSheet表工作，程序修改部分如下：
For i=1 to 3
Sheets(i).Select
'....这里存放原来的语句，里面凡是有使用Sheets的都要删除....
Next i
vba怎么选择多个工作簿中的最后三个工作表，然后依次移动到当前工作簿中？？
Sub 合并工作表()
On Error Resume Next
Dim wb As Workbook, sh As Worksheet
Dim fn As String, pt As String,t
t=timer
'------------------------检测否打excel文件-------------------
If Workbooks.Count > 1 Then
MsgBox "请关闭其余工作簿"
Exit Sub
End If
'------------------------选择要合并工作簿所文件夹获取路径---------
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then
MsgBox "没选择任何文件夹"
Exit Sub
Else
pt = .SelectedItems(1)
End If
End With
'-------------------------遍历文件夹所Excel文件并进行处理--------
fn = Dir(pt & "\*.xls") '若文档2007或更新版本则*.xls改*.xlsx
Do While fn > ""
If fn > ThisWorkbook.Name Then
k=k+1
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wb = Workbooks.Open(pt & "\" & fn, , True)
Set sh = ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
wb.Worksheets(1).Rows.Copy sh.Rows
sh.Name = "工作簿" & Left(fn, Len(fn) - IIf(Right(fn, 1) = "x", 5, 4))
wb.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End If
fn = Dir
Loop
msgbox "处理结束共处理" & k &"文件耗" & timer-t & "秒"
ThisWorkbook.Save
End Sub
excel vba 筛选另存为工作表
Sub 数据分拣()
Application.ScreenUpdating = False
Dim sh As Worksheet
For i = 1 To Application.Max(Worksheets("词排名").Range("A:A"))
Set sh = Worksheets.Add(after:=Worksheets(Worksheets.Count))
For j = 2 To Sheets("词排名").[d65536].End(3).Row
If Sheets("词排名").Cells(j, 3) = 1 And Sheets("词排名").Cells(j, 4) = i Then
sh.Range("A" & Application.CountA(sh.Range("A:A")) + 1) = Sheets("词排名").Cells(j, 2)
End If
Next
sh.Name = Format(i, "00")
Next
Application.ScreenUpdating = True
End Sub