kode saya berfungsi dengan baik sebagai makro namun gagal ketika saya menjalankannya di sebuah tombol


0

Sejauh ini, satu baris gagal ketika saya mencoba untuk mengambil makro yang berfungsi dengan baik sebagai makro tetapi gagal ketika saya menyalin kode ke tombol perintah klik ...

Sheets(c.Value).Range("a1:i330").Copy Destination:=Sheets("estimating1").Range("a1")

apa yang saya lakukan salah? Saya memiliki lembar sepenuhnya ditetapkan untuk salinan dan tujuan

apakah ini masalah sintaksis, apakah perintah di atas benar?

di sini adalah seluruh kode:

Private Sub CommandButton1_Click()
    'Sub grand10()
    ' grand10 Macro
    'this is a button macro that adds Grand10, SubGrand10, StartTime, EndTime and CheckBalance
    'but it doesnt work
    '
    Dim wkb As Workbook
    Dim wks As Worksheet
    Dim lastcolumn As Long
    Dim lastrow As Long

    MsgBox ("this should take 2-3 seconds per fixture")

    'set timer variables
    Dim StartTime As Double
    Dim SecondsElapsed As Double

    'start the timer
    StartTime = Timer

    'run starttime which put time in a cell on bigmaster
    'Application.Run "starttime" - begin

    'Sheets("bigmaster").Select
    'Sheets("bigmaster").Range("U1").Select
    Sheets("bigmaster").Range("U1").FormulaR1C1 = "=NOW()"
    Sheets("bigmaster").Range("U1").Copy
    'Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'Application.Run "starttime" - end

    'clear the temp sheets
    'Sheets("estimating1").Select
    Sheets("estimating1").Range("a1:i330").ClearContents
    'Selection.ClearContents
    'Sheets("Master").Select
    Sheets("Master").Range("A2:P39").ClearContents
    'Selection.ClearContents
    'Sheets("bigmaster").Select
    Sheets("bigmaster").Columns("A:P").ClearContents
    'Selection.ClearContents


    For Each wks In ThisWorkbook.Worksheets

        Set wkb = ThisWorkbook
        Application.DisplayAlerts = False
        Set c = Sheets("formulas").Range("j19:j148").Find(wks.Name, lookat:=xlWhole)
        If Not c Is Nothing Then

            'Pick sheets A,B,C...
            'Sheets(c.Value).Select

            'get the whole range of the estimating sheet excluding change orders
            Sheets(c.Value).Range("a1:i330").Copy 'Destination:=Sheets("estimating1").Range("a1")
            'Selection.Copy
            'Sheets("estimating1").Select

            'paste to A1 as an anchor
            'Sheets("estimating1").Range("a1").Paste
            Sheets("estimating1").Range("a1").Paste
            'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            ':=False, Transpose:=False
            'ActiveSheet.Paste
            'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            '    :=False, Transpose:=False

            If Sheets("estimating1").Range("B38") = 0 Then GoTo skiptonext:

            'begin sub macro here, this macro is the steps on the estimating sheet, no looping
            'Application.Run "SubGrand10" - begin
            'Sub SubGrand10()
            '
            ' SubGrand10 Macro
            '
                'Copy Phase and Description
                'Sheets("Formulas").Select
                Sheets("Formulas").Range("D33:E69").Copy
                'Selection.Copy

                'paste to Master C2
                'Sheets("Master").Select
                Sheets("Master").Range("C2").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

                'Copy Hours from Estimating1
                'Sheets("Estimating1").Select
                Sheets("Estimating1").Range("B1:B37").Select
                Application.CutCopyMode = False
                Selection.Copy

                'Paste to Master H2 - Man Hours
                'Sheets("Master").Select
                Sheets("Master").Range("H2").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

                'now move materials to Unit Cost
                Sheets("Master").Range("H33:H38").Select
                Application.CutCopyMode = False
                Selection.Cut Destination:=Range("G33:G38")

                'put hourly rate ($35) in column I
                Sheets("Master").Range("I2").Select
                ActiveCell.FormulaR1C1 = "35"
                Selection.AutoFill Destination:=Range("I2:I32"), Type:=xlFillDefault

                'now paste formula in J2
                Sheets("Master").Range("J2").Select
                ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-2]"
                Selection.AutoFill Destination:=Range("J2:J38"), Type:=xlFillDefault

                'Now paste cost type 1 in labor hours E2
                Sheets("Master").Range("E2").Select
                ActiveCell.FormulaR1C1 = "1"
                Selection.AutoFill Destination:=Range("E2:E38"), Type:=xlFillDefault

                'paste formula for materials
                Sheets("Master").Range("J33").Select
                ActiveCell.FormulaR1C1 = "=RC[-3]*RC[-5]"
                Selection.AutoFill Destination:=Range("J33:J38"), Type:=xlFillDefault

                'now put EA in column F
                Sheets("Master").Range("F2").Select
                ActiveCell.FormulaR1C1 = "EA"
                Selection.AutoFill Destination:=Range("F2:F38"), Type:=xlFillDefault

                'now put exhibit (A,B,C...) in P2
                Sheets("Master").Range("P2").Select
                ActiveCell.Formula = "=Estimating1!F5"
                Selection.Copy
                Range("P2:P38").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

                'now get vlookup from formulas sheet
                'Sheets("Formulas").Select
                Sheets("Formulas").Range("O19").Select
                Application.CutCopyMode = False
                Selection.Copy

                'paste to A2
                'Sheets("Master").Select
                Sheets("Master").Range("A2").Select
                ActiveSheet.Paste
                Application.CutCopyMode = False
                ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[15],lookupABC123,3,FALSE)"
                Selection.AutoFill Destination:=Range("A2:A38"), Type:=xlFillDefault

                'now get name of fixture and put in B2
                Sheets("Master").Range("B2").Select
                ActiveCell.Formula = "=Estimating1!E10"
                Selection.Copy
                Sheets("Master").Range("B2:B38").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

                'put cost type in...
                'Sheets("Formulas").Select
                Sheets("Formulas").Range("O22").Select
                Application.CutCopyMode = False
                Selection.Copy

                'and paste it to L2
                'Sheets("Master").Select
                Sheets("Master").Range("L2").Select
                ActiveSheet.Paste
                Application.CutCopyMode = False
                ActiveCell.FormulaR1C1 = "=IF(RC[-3]>0,1,3)"
                Selection.AutoFill Destination:=Range("L2:L38"), Type:=xlFillDefault

                'now get formula for Grand Total
                'Sheets("Formulas").Select
                Sheets("Formulas").Range("O25").Select

                'paste it to O2
                Selection.Copy
                'Sheets("Master").Select
                Sheets("Master").Range("O2").Select
                ActiveSheet.Paste
                Application.CutCopyMode = False
                ActiveCell.FormulaR1C1 = "=SUM(C[-5])"
                Sheets("Master").Range("O2").Select
                Selection.Copy
                Sheets("Master").Range("O2:O38").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

                'get formula for Phase codes
                'Sheets("Formulas").Select
                Sheets("Formulas").Range("O27").Select
                Application.CutCopyMode = False
                Selection.Copy

                'and paste it to K2
                'Sheets("Master").Select
                Sheets("Master").Range("K2").Select
                ActiveSheet.Paste
                Application.CutCopyMode = False
                ActiveCell.FormulaR1C1 = "=RC[-10]&"".""&RC[-8]"
                Selection.AutoFill Destination:=Range("K2:K38"), Type:=xlFillDefault

                'now get descriptin and paste it to N2
                'Sheets("Formulas").Select
                Sheets("Formulas").Range("O29").Select
                Selection.Copy
                'Sheets("Master").Select
                Sheets("Master").Range("N2").Select
                ActiveSheet.Paste
                Application.CutCopyMode = False
                ActiveCell.FormulaR1C1 = "=RC[-10]&"".""&RC[-12]"
                Selection.AutoFill Destination:=Range("N2:N38"), Type:=xlFillDefault

                'add formula for contract item
                Sheets("Master").Range("M2").Select
                ActiveCell.FormulaR1C1 = "=RC[-12]"
                Selection.AutoFill Destination:=Range("M2:M38"), Type:=xlFillDefault
            'End Sub

            'Application.Run "SubGrand10" - end

            'remove 0 from J column
            'Application.Run "removeJRows" - begin

            Application.ScreenUpdating = False
            'Dim wkb As Workbook
            'Dim wks As Worksheet
            Set wkb = ThisWorkbook
            filtercolumn = "J"
            Set wks = wkb.Sheets("master")
            totalrows = wks.Cells(Rows.Count, "A").End(xlUp).Row
            For j = totalrows To 1 Step -1
                If wks.Cells(j, filtercolumn) = 0 Then
                    wks.Rows(j).Delete
                End If
            Next j
            Application.ScreenUpdating = True

            'Application.Run "removeJRows" - begin

            'now copy master and put it on next available row on bigmaster
                With Sheets("master")
                    .Range("A1").CurrentRegion.Offset(1).Copy
                    If Sheets("BigMaster").Range("A1") = "" Then
                        Sheets("BigMaster").Range("A1").PasteSpecial xlPasteValues
                    Else
                        Sheets("BigMaster").Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
                    End If
                End With
            'end sub macro here

            'clear master and estimating1
            Sheets("estimating1").Select
            Range("a2:i320").Select
            Selection.ClearContents
            Sheets("Master").Select
            Range("A2:P39").Select
            Selection.ClearContents
        End If

        'label for skipping pages with a 0 balance
    skiptonext:
    Next
        'subGrand10 all done, finish with the sum of J
        'put the sum of column J here
        Sheets("bigmaster").Select

        Range("R1").Select
        ActiveCell.FormulaR1C1 = "=SUM(C[-8])"

        'put the sum of all estimating sheets here
        Range("R3").Select

        'ActiveCell.FormulaR1C1 = "=SUM(A:OOOOO!R[92]C[-16])"
        ActiveCell.Formula = "=SUM(A:OOOOO!B38)"

        'add statement confiming Balanced, if not then Out of Balance
        Range("R5").Select
        ActiveCell.FormulaR1C1 = "=IF(R[-4]C=R[-2]C,""Balanced"",""Out of Balance"")"

        'color balanced with green, out of balanace with red
        If Range("R5") = "Balanced" _
        Then Range("R5").Interior.ColorIndex = 4 _
        Else Range("R5").Interior.ColorIndex = 3

        'check for balance, if so then msgbox the result
        'Application.Run "CheckBalance" - begin

        If Sheets("bigmaster").Range("R5") = "Balanced" Then MsgBox ("Sheets balanced")

        'Application.Run "CheckBalance" - end

        'put time and elapsed in a cell on bigmaster
        'Application.Run "endtime" - begin

        Sheets("bigmaster").Select
        Range("T1").Select
        ActiveCell.FormulaR1C1 = "Start"
        Range("T2").Select
        ActiveCell.FormulaR1C1 = "End"
        Range("T3").Select
        ActiveCell.FormulaR1C1 = "Elapsed"
        Range("U2").Select
        ActiveCell.FormulaR1C1 = "=NOW()"
        Range("U2").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("U3").Select
        Application.CutCopyMode = False
        ActiveCell.FormulaR1C1 = "=R[-1]C-R[-2]C"

        'Application.Run "endtime" - end

        'prepare msgbox for elapsed time in seconds
        SecondsElapsed = Round(Timer - StartTime, 2)
        MsgBox "This macro ran successfully in " & SecondsElapsed & " seconds", vbInformation

    'End Sub
    End Sub

Apa maksudmu "gagal"? Apakah Anda mendapatkan kesalahan? Jika demikian, kesalahan apa?
Kyle

saya mendapatkan galat Run time "438": objek tidak mendukung properti atau metode ini
DanM

ada selectiondalam kode?
Raystafarian

ya ada, tetapi saya mencoba untuk mengkonversi mereka sehingga. Pilih tidak muncul lagi.
DanM

Apa yang Anda harapkan c.Value? Itu harus berupa string. Di Anda Find, Anda mengembalikan Rangejika saya tidak salah. Jadi, saya berasumsi c.Valueakan seperti mySheetname? Ketika kesalahan, di Jendela Segera (tekan CTRL + G di VBEditor), dan ketik ?c.Valuedan lihat apa yang kembali.
BruceWayne
Dengan menggunakan situs kami, Anda mengakui telah membaca dan memahami Kebijakan Cookie dan Kebijakan Privasi kami.
Licensed under cc by-sa 3.0 with attribution required.