Darren.NET

'Description：複製工作表( 相同活頁簿) - Ver. 1.00 'Parameters：wb 活頁簿, strWorkSheet 欲複製的工作表名稱, varWsAfter 工作表索引或名稱(插入其之後), strFind 欲消除的字串, ' strRep 代替的字串,strSoureRange 欲複製的儲存格範圍, strToCell 目標儲存格 'Return： 'Package：mFunction.F_Worksheet_isExist 'Reference： 'Creater：Darren.NET - 2009/04/22 'Modify： Public Sub S_Worksheet_CopyWbWsAfter(wb As Workbook, strWorkSheet As String, varWsAfter As Variant, strFind As String, strRep As String, strSoureRange As String, strToCell As String) On Error Resume Next Dim wsNew, ws As Worksheet If mFunction.F_Worksheet_isExist(wb, strWorkSheet) = True Then Set wsNew = wb.Worksheets.Add(After:=wb.Worksheets(varWsAfter)) wsNew.Name = Replace(strWorkSheet, strFind, strRep) Set ws = wb.Worksheets(strWorkSheet) ws.Range(strSoureRange).Copy (wsNew.Range(strToCell)) End If Set ws = Nothing Set wsNew = Nothing End Sub