使用VBA使用现有工作表的格式创建新工作表

时间：2018-01-15 16:26:55

标签： excel vba excel-vba

所以我创建了一个名为new sheets的工作表，它与VBA代码链接以执行某些操作。我希望能够添加与template表格具有相同格式和vba代码的Private Sub Workbook_NewSheet(ByVal Sh As Object) Application.ScreenUpdating = False Application.EnableEvents = False Application.DisplayAlerts = False Sh.Delete '-----delete added new page Application.DisplayAlerts = True work.Copy After:=ThisWorkbook.Sheets(1) '-----copy page with formulas, vba code and data Dim n As Integer 'clear all filled content at new page, so it is "new"=clean n = ActiveSheet.Range("L8").CurrentRegion.Rows.Count + 7 ActiveSheet.Rows("13:" & n).Delete Shift:=xlUp ActiveSheet.Range("M8:W12").ClearContents Application.CutCopyMode = False ActiveSheet.Range("B8").Select Selection.ClearContents ActiveSheet.Range("B8").Activate Application.ScreenUpdating = True Application.EnableEvents = True End Sub 。

我使用的代码是。 

Private Sub Add_Click()
Dim n As Integer
Application.ScreenUpdating = False
Application.EnableEvents = False

n = ActiveSheet.Range("L8").CurrentRegion.Rows.Count + 7   'number of filled rows of records
ActiveSheet.Rows(n - 4 & ":" & n).Copy                     ' adding new record by copy previous one
ActiveSheet.Rows(n + 1 & ":" & n + 1).Select
ActiveSheet.Paste
ActiveSheet.Range("M" & n + 1 & ":W" & n + 5).ClearContents        'clear data in new added(=copied) record
Application.CutCopyMode = False
ActiveSheet.Range("B" & n + 1).Select
Selection.ClearContents

n = ActiveSheet.Range("L8").CurrentRegion.Rows.Count + 7   'number of filled rows
'------total sum
ActiveSheet.Range("U6").Formula = "=SUM(U8:U" & n & ")"
ActiveSheet.Range("V6").Formula = "=SUM(V8:V" & n & ")"
ActiveSheet.Range("W6").Formula = "=SUM(W8:W" & n & ")"
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Activate()
'------------------------on worksheet activate update all dropdownlists
Application.EnableEvents = False
Dim n As Integer
Dim m As Integer

n = temp.Range("B2").CurrentRegion.Rows.Count + 1

'-------update dropdownlist for eg tag
m = ActiveSheet.Range("L8").CurrentRegion.Rows.Count + 7
With ActiveSheet.Range("B8:B" & m).Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="='Hidden Page'!$B$3:$B$" & n
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = False
End With

Dim i As Integer

For i = 8 To m - 4 Step 5
'-----------update formula for eg tag record
n = temp.Range("B2").CurrentRegion.Rows.Count + 1
ActiveSheet.Range("C" & i).Formula = "=VLOOKUP(B" & i & ",'Hidden Page'!$B$3:$K$" & n & ",2,0)"
ActiveSheet.Range("D" & i).Formula = "=VLOOKUP(B" & i & ",'Hidden Page'!$B$3:$K$" & n & ",3,0)"
ActiveSheet.Range("E" & i).Formula = "=VLOOKUP(B" & i & ",'Hidden Page'!$B$3:$K$" & n & ",4,0)"
ActiveSheet.Range("F" & i).Formula = "=VLOOKUP(B" & i & ",'Hidden Page'!$B$3:$K$" & n & ",5,0)"
ActiveSheet.Range("G" & i).Formula = "=VLOOKUP(B" & i & ",'Hidden Page'!$B$3:$K$" & n & ",6,0)"
ActiveSheet.Range("H" & i).Formula = "=VLOOKUP(B" & i & ",'Hidden Page'!$B$3:$K$" & n & ",7,0)"
ActiveSheet.Range("I" & i).Formula = "=VLOOKUP(B" & i & ",'Hidden Page'!$B$3:$K$" & n & ",8,0)"
ActiveSheet.Range("J" & i).Formula = "=VLOOKUP(B" & i & ",'Hidden Page'!$B$3:$K$" & n & ",9,0)"
ActiveSheet.Range("K" & i).Formula = "=VLOOKUP(B" & i & ",'Hidden Page'!$B$3:$K$" & n & ",10,0)"

'----update Impeller
Application.Union(ActiveSheet.Range("M" & i), ActiveSheet.Range("O" & i), ActiveSheet.Range("Q" & i), ActiveSheet.Range("S" & i)).Select
n = temp.Range("M5").CurrentRegion.Rows.Count + 4
With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="='Hidden Page'!$M$6:$M$" & n
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = False
End With

'----update TB
Application.Union(ActiveSheet.Range("M" & i + 1), ActiveSheet.Range("O" & i + 1), ActiveSheet.Range("Q" & i + 1), ActiveSheet.Range("S" & i + 1)).Select
n = temp.Range("Y5").CurrentRegion.Rows.Count + 4
With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="='Hidden Page'!$Y$6:$Y$" & n
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = False
End With

'----update Volute
Application.Union(ActiveSheet.Range("M" & i + 2), ActiveSheet.Range("O" & i + 2), ActiveSheet.Range("Q" & i + 2), ActiveSheet.Range("S" & i + 2)).Select
n = temp.Range("AK5").CurrentRegion.Rows.Count + 4
With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="='Hidden Page'!$AK$6:$AK$" & n
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = False
End With

'----update FPLI
Application.Union(ActiveSheet.Range("M" & i + 3), ActiveSheet.Range("O" & i + 3), ActiveSheet.Range("Q" & i + 3), ActiveSheet.Range("S" & i + 3)).Select
n = temp.Range("AW5").CurrentRegion.Rows.Count + 4
With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="='Hidden Page'!$AW$6:$AW$" & n
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = False
End With

'----update SS
Application.Union(ActiveSheet.Range("M" & i + 4), ActiveSheet.Range("O" & i + 4), ActiveSheet.Range("Q" & i + 4), ActiveSheet.Range("S" & i + 4)).Select
n = temp.Range("BI5").CurrentRegion.Rows.Count + 4
With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="='Hidden Page'!$BI$6:$BI$" & n
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = False
End With
Next i

Application.EnableEvents = True
ActiveSheet.Range("L6") = ""  '------to call worksheet change event to refresh all data after change on hidden page
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Columns.Count = 1 Then
        If Target.Column >= 12 And Target.Column <= 20 Then  '-----------------when table with details and QTY filled or changed then count price and costs
            Application.EnableEvents = False
            Dim oper As Integer
            Dim cost As Integer
            Dim sale As Integer
            Dim gross As Integer

            Dim q1 As Double
            Dim q2 As Double
            Dim q3 As Double
            Dim q4 As Double

            Dim tot_cost As Integer
            Dim tot_sale As Integer
            Dim tot_gross As Integer
            Dim i As Integer

            '--------ranges of tables of parts Impeller,TB,Volute,FPLI,SS on HiddenPage
            Dim rng2(8 To 12) As String

            rng2(8) = "M6:W" & temp.Range("M5").CurrentRegion.Rows.Count + 4
            rng2(9) = "Y6:AI" & temp.Range("Y5").CurrentRegion.Rows.Count + 4
            rng2(10) = "AK6:AU" & temp.Range("AK5").CurrentRegion.Rows.Count + 4
            rng2(11) = "AW6:BG" & temp.Range("AW5").CurrentRegion.Rows.Count + 4
            rng2(12) = "BI6:BS" & temp.Range("BI5").CurrentRegion.Rows.Count + 4

            Dim j As Integer
            Dim n As Integer
            n = ActiveSheet.Range("L8").CurrentRegion.Rows.Count + 7
            Dim m As Integer
            Dim k As Integer
            k = 0
        For j = 8 To n - 4 Step 5           '-----------loop through all records =every 4 rows

            oper = CInt(ActiveSheet.Range("C" & j).Value)   '------read operator
            '-----based on operator get number of column for the operator
            If oper = 1 Then
                cost = 3
                sale = 6
                gross = 9
            ElseIf oper = 2 Then
                cost = 4
                sale = 7
                gross = 10
            ElseIf oper = 3 Then
                cost = 5
                sale = 8
                gross = 11
            End If

            m = j + 4

            For i = j To m    '---------loop through every row of one record
                '---------------if specified part(=not empty) then find the price for part and save in variable q1,q2,q3,q4
                '-----for cost
                q1 = 0
                q2 = 0
                q3 = 0
                q4 = 0
                If ActiveSheet.Range("M" & i) <> "" Then q1 = Application.WorksheetFunction.VLookup(ActiveSheet.Range("M" & i), temp.Range(rng2(i - k)), cost, 0)
                If ActiveSheet.Range("O" & i) <> "" Then q2 = Application.WorksheetFunction.VLookup(ActiveSheet.Range("O" & i), temp.Range(rng2(i - k)), cost, 0)
                If ActiveSheet.Range("Q" & i) <> "" Then q3 = Application.WorksheetFunction.VLookup(ActiveSheet.Range("Q" & i), temp.Range(rng2(i - k)), cost, 0)
                If ActiveSheet.Range("S" & i) <> "" Then q4 = Application.WorksheetFunction.VLookup(ActiveSheet.Range("S" & i), temp.Range(rng2(i - k)), cost, 0)
                ActiveSheet.Range("U" & i) = q1 * ActiveSheet.Range("N" & i) + q2 * ActiveSheet.Range("P" & i) + q3 * ActiveSheet.Range("R" & i) + q4 * ActiveSheet.Range("T" & i)

                '---for sale
                q1 = 0
                q2 = 0
                q3 = 0
                q4 = 0
                If ActiveSheet.Range("M" & i) <> "" Then q1 = Application.WorksheetFunction.VLookup(ActiveSheet.Range("M" & i), temp.Range(rng2(i - k)), sale, 0)
                If ActiveSheet.Range("O" & i) <> "" Then q2 = Application.WorksheetFunction.VLookup(ActiveSheet.Range("O" & i), temp.Range(rng2(i - k)), sale, 0)
                If ActiveSheet.Range("Q" & i) <> "" Then q3 = Application.WorksheetFunction.VLookup(ActiveSheet.Range("Q" & i), temp.Range(rng2(i - k)), sale, 0)
                If ActiveSheet.Range("S" & i) <> "" Then q4 = Application.WorksheetFunction.VLookup(ActiveSheet.Range("S" & i), temp.Range(rng2(i - k)), sale, 0)
                ActiveSheet.Range("V" & i) = q1 * ActiveSheet.Range("N" & i) + q2 * ActiveSheet.Range("P" & i) + q3 * ActiveSheet.Range("R" & i) + q4 * ActiveSheet.Range("T" & i)

                '----for gross
                q1 = 0
                q2 = 0
                q3 = 0
                q4 = 0
                If ActiveSheet.Range("M" & i) <> "" Then q1 = Application.WorksheetFunction.VLookup(ActiveSheet.Range("M" & i), temp.Range(rng2(i - k)), gross, 0)
                If ActiveSheet.Range("O" & i) <> "" Then q2 = Application.WorksheetFunction.VLookup(ActiveSheet.Range("O" & i), temp.Range(rng2(i - k)), gross, 0)
                If ActiveSheet.Range("Q" & i) <> "" Then q3 = Application.WorksheetFunction.VLookup(ActiveSheet.Range("Q" & i), temp.Range(rng2(i - k)), gross, 0)
                If ActiveSheet.Range("S" & i) <> "" Then q4 = Application.WorksheetFunction.VLookup(ActiveSheet.Range("S" & i), temp.Range(rng2(i - k)), gross, 0)
                ActiveSheet.Range("W" & i) = q1 * ActiveSheet.Range("N" & i) + q2 * ActiveSheet.Range("P" & i) + q3 * ActiveSheet.Range("R" & i) + q4 * ActiveSheet.Range("T" & i)
            Next i
            k = k + 5
        Next j

        n = ActiveSheet.Range("L8").CurrentRegion.Rows.Count + 7
        '----count total sum after QTY or parts were changed
        ActiveSheet.Range("U6").Formula = "=SUM(U8:U" & n & ")"
        ActiveSheet.Range("V6").Formula = "=SUM(V8:V" & n & ")"
        ActiveSheet.Range("W6").Formula = "=SUM(W8:W" & n & ")"

            Application.EnableEvents = True
        End If
    End If
End Sub

代码功能，但有时我会在下面附上此错误。 我不知道如何解决此错误。

Copy Error

Copy Error 2

下面的代码，是我想要的表单。 

*** Variables ***
${EXPECTED URL}                       https://www.test.com

1 个答案:

答案 0 :(得分：0)

找到一个有效的解决方案!!

感谢您的帮助。 

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    ActiveSheet.Delete   '-----delete added new page
    Application.DisplayAlerts = True
    ThisWorkbook.Sheets("Template Sheet").Visible = True
    ThisWorkbook.Sheets("Template Sheet").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)  '-----copy page with formulas, vba code and data
    ThisWorkbook.Sheets("Template Sheet").Visible = False
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

这是使用的新代码。

相关问题
最新问题