Looking to clean up a VBA command button, but I suck at coding-CodePudding

I have several bits of data that are entered manually by one of my employees, then the form is cleared when they hit a button. The data is then transferred over to another sheet using some VBA I cobbled together, and the sheet is then password protected. Unfortunately, I wasn't sure how to do this, so i found bits and pieces of code and tied them together enough to make it work... The programming equivalent of gum, duct tape and baling wire. Any chance anyone can look at this and tell me how I can copy a column into a row, rather than the version I've come up with? There are multiple sheets, one with the actual data, and one that I use to archive it depending on where the data was for. Sheet names are "active run" and "11A", "11B", etc.

    Private Sub CommandButton3_Click()

'Time check
If IsEmpty(Range("D7").Value) = True Then
MsgBox "No Time Stamp!", vbOKCancel   vbCritical
 Exit Sub
End If

'name check
If InStr(1, (Range("R7").Value), "<Choose one>") > 0 Then
MsgBox "Select a name from the pull-down menu", vbOKCancel   vbCritical
 Exit Sub
End If

Application.ScreenUpdating = False

ActiveSheet.Unprotect "password"
Worksheets("11A Run Data").Unprotect "password"
Worksheets("11B Run Data").Unprotect "password"
Worksheets("12A Run Data").Unprotect "password"
Worksheets("12B Run Data").Unprotect "password"
Worksheets("13A Run Data").Unprotect "password"
Worksheets("13B Run Data").Unprotect "password"



If MsgBox("This will clear all data!" & vbCr & "Do you wish to proceed?", vbOKCancel   vbExclamation, "Warning!") = vbOK Then
   

'Name
    
Sheets("Active Run").Range("R7").Copy
With Sheets("11A Run Data").Range("A" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteValues
End With
Sheets("Active Run").Range("R7").Copy
With Sheets("11B Run Data").Range("A" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteValues
End With

Sheets("Active Run").Range("R7").Copy
With Sheets("12A Run Data").Range("A" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteValues
End With
Sheets("Active Run").Range("R7").Copy
With Sheets("12B Run Data").Range("A" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteValues
End With

Sheets("Active Run").Range("R7").Copy
With Sheets("13A Run Data").Range("A" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteValues
End With
Sheets("Active Run").Range("R7").Copy
With Sheets("13B Run Data").Range("A" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteValues
End With


'Date
Sheets("Active Run").Range("AC8").Copy
With Sheets("11A Run Data").Range("B" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteValues
End With
Sheets("Active Run").Range("AC8").Copy
With Sheets("11B Run Data").Range("B" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteValues
End With

Sheets("Active Run").Range("AC8").Copy
With Sheets("12A Run Data").Range("B" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteValues
End With
Sheets("Active Run").Range("AC8").Copy
With Sheets("12B Run Data").Range("B" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteValues
End With

Sheets("Active Run").Range("AC8").Copy
With Sheets("13A Run Data").Range("B" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteValues
End With
Sheets("Active Run").Range("AC8").Copy
With Sheets("13B Run Data").Range("B" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteValues
End With



'Time
Sheets("Active Run").Range("AD8").Copy
With Sheets("11A Run Data").Range("C" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteValues
End With
Sheets("Active Run").Range("AD8").Copy
With Sheets("11B Run Data").Range("C" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteValues
End With

Sheets("Active Run").Range("AD8").Copy
With Sheets("12A Run Data").Range("C" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteValues
End With
Sheets("Active Run").Range("AD8").Copy
With Sheets("12B Run Data").Range("C" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteValues
End With

Sheets("Active Run").Range("AD8").Copy
With Sheets("13A Run Data").Range("C" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteValues
End With
Sheets("Active Run").Range("AD8").Copy
With Sheets("13B Run Data").Range("C" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteValues
End With



'*****************************************************************************************

'*****************************************************************************************
'Molds-11
    Sheets("Active Run").Range("D10:F10").Copy
        With Sheets("11A Run Data").Range("E" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("G10:I10").Copy
        With Sheets("11B Run Data").Range("E" & Rows.Count).End(xlUp).Offset(1)
             .PasteSpecial Paste:=xlPasteValues
        End With
'*****************************************************************************
'Molds-12
    Sheets("Active Run").Range("K10:M10").Copy
        With Sheets("12A Run Data").Range("E" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("N10:P10").Copy
        With Sheets("12B Run Data").Range("E" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
'*****************************************************************************
'Molds-13
    Sheets("Active Run").Range("R10:T10").Copy
        With Sheets("13A Run Data").Range("E" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("U10:W10").Copy
        With Sheets("13B Run Data").Range("E" & Rows.Count).End(xlUp).Offset(1)
          .PasteSpecial Paste:=xlPasteValues
        End With

'*****************************************************************************************

'*****************************************************************************************
'Blowheads-11
    Sheets("Active Run").Range("D11:F11").Copy
        With Sheets("11A Run Data").Range("H" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("G11:I11").Copy
        With Sheets("11B Run Data").Range("H" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
'*****************************************************************************
'Blowheads-12
    Sheets("Active Run").Range("K11:M11").Copy
        With Sheets("12A Run Data").Range("H" & Rows.Count).End(xlUp).Offset(1)
           .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("N11:O11").Copy
        With Sheets("12B Run Data").Range("H" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
'*****************************************************************************
'Blowheads-13
    Sheets("Active Run").Range("R11:T11").Copy
        With Sheets("13A Run Data").Range("H" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("U11:W11").Copy
        With Sheets("13B Run Data").Range("H" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With

'*****************************************************************************************

'*****************************************************************************************
'Blanks-11
    Sheets("Active Run").Range("D12:F12").Copy
        With Sheets("11A Run Data").Range("K" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("G12:I12").Copy
        With Sheets("11B Run Data").Range("K" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
'*****************************************************************************
'Blanks-12
    Sheets("Active Run").Range("K12:M12").Copy
        With Sheets("12A Run Data").Range("K" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("N12:P12").Copy
        With Sheets("12B Run Data").Range("K" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
'*****************************************************************************
'Blanks-13
    Sheets("Active Run").Range("R12:T12").Copy
        With Sheets("13A Run Data").Range("K" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("U12:W12").Copy
        With Sheets("13B Run Data").Range("K" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With

'*****************************************************************************************

'*****************************************************************************************

'Rings-11
    Sheets("Active Run").Range("D13:F13").Copy
        With Sheets("11A Run Data").Range("N" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("G13:I13").Copy
        With Sheets("11B Run Data").Range("N" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
'*****************************************************************************
'Rings-12
    Sheets("Active Run").Range("K13:M13").Copy
        With Sheets("12A Run Data").Range("N" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("N13:P13").Copy
        With Sheets("12B Run Data").Range("N" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
'*****************************************************************************
'Rings-13
    Sheets("Active Run").Range("R13:T13").Copy
        With Sheets("13A Run Data").Range("N" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("U13:W13").Copy
        With Sheets("13B Run Data").Range("N" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With

'*****************************************************************************************

'*****************************************************************************************

'Guides-11
    Sheets("Active Run").Range("D14:F14").Copy
        With Sheets("11A Run Data").Range("Q" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("G14:I14").Copy
        With Sheets("11B Run Data").Range("Q" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
'*****************************************************************************
'Guides-12
    Sheets("Active Run").Range("K14:M14").Copy
        With Sheets("12A Run Data").Range("Q" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("N14:P14").Copy
        With Sheets("12B Run Data").Range("Q" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
'*****************************************************************************
'Guides-13
    Sheets("Active Run").Range("R14:T14").Copy
        With Sheets("13A Run Data").Range("Q" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("U14:W14").Copy
        With Sheets("13B Run Data").Range("Q" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With

'*****************************************************************************************

'*****************************************************************************************

'Baffles-11
    Sheets("Active Run").Range("D15:F15").Copy
        With Sheets("11A Run Data").Range("T" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("G15:I15").Copy
        With Sheets("11B Run Data").Range("T" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
'*****************************************************************************
'Baffles-12
    Sheets("Active Run").Range("K15:M15").Copy
        With Sheets("12A Run Data").Range("T" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("N15:P15").Copy
        With Sheets("12B Run Data").Range("T" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
'*****************************************************************************
'Baffles-13
    Sheets("Active Run").Range("R15:T15").Copy
        With Sheets("13A Run Data").Range("T" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("U15:W15").Copy
        With Sheets("13B Run Data").Range("T" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With

'*****************************************************************************************

'*****************************************************************************************

'Plungers-11
    Sheets("Active Run").Range("D16:F16").Copy
        With Sheets("11A Run Data").Range("W" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("G16:I16").Copy
        With Sheets("11B Run Data").Range("W" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
'*****************************************************************************
'Plungers-12
    Sheets("Active Run").Range("K16:M16").Copy
        With Sheets("12A Run Data").Range("W" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("N16:P16").Copy
        With Sheets("12B Run Data").Range("W" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
'*****************************************************************************
'Plungers-13
    Sheets("Active Run").Range("R16:T16").Copy
        With Sheets("13A Run Data").Range("W" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("U16:W16").Copy
        With Sheets("13B Run Data").Range("W" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With

'*****************************************************************************************

'*****************************************************************************************

'Thimbles-11
    Sheets("Active Run").Range("D17:F17").Copy
        With Sheets("11A Run Data").Range("Z" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("G17:I17").Copy
        With Sheets("11B Run Data").Range("Z" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
'*****************************************************************************
'Thimbles-12
    Sheets("Active Run").Range("K17:M17").Copy
        With Sheets("12A Run Data").Range("Z" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("N17:P17").Copy
        With Sheets("12B Run Data").Range("Z" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
'*****************************************************************************
'Thimbles-13
    Sheets("Active Run").Range("R17:T17").Copy
        With Sheets("13A Run Data").Range("Z" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("U17:W17").Copy
        With Sheets("13B Run Data").Range("Z" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With

'*****************************************************************************************

'*****************************************************************************************

'Funnels-11
    Sheets("Active Run").Range("D18:F18").Copy
        With Sheets("11A Run Data").Range("AC" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("G18:I18").Copy
        With Sheets("11B Run Data").Range("AC" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
'*****************************************************************************
'Funnels-12
    Sheets("Active Run").Range("K18:M18").Copy
        With Sheets("12A Run Data").Range("AC" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("N18:P18").Copy
        With Sheets("12B Run Data").Range("AC" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
'*****************************************************************************
'Funnels-13
    Sheets("Active Run").Range("R18:T18").Copy
        With Sheets("13A Run Data").Range("AC" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("U18:W18").Copy
        With Sheets("13B Run Data").Range("AC" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With

'*****************************************************************************************

'*****************************************************************************************
'Bottom Plates-11
    Sheets("Active Run").Range("D19:F19").Copy
        With Sheets("11A Run Data").Range("AF" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("G19:I19").Copy
        With Sheets("11B Run Data").Range("AF" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
'*****************************************************************************
'Bottom Plates-12
    Sheets("Active Run").Range("K19:M19").Copy
        With Sheets("12A Run Data").Range("AF" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("N19:P19").Copy
        With Sheets("12B Run Data").Range("AF" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
'*****************************************************************************
'Bottom Plates-13
    Sheets("Active Run").Range("R19:T19").Copy
        With Sheets("13A Run Data").Range("AF" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With
    Sheets("Active Run").Range("U19:W19").Copy
        With Sheets("13B Run Data").Range("AF" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteValues
        End With

'*****************************************************************************************

'*****************************************************************************************


Sheets("Active Run").Range("D7") = ""
Sheets("Active Run").Range("R7") = "<Choose one>"
Sheets("Active Run").Range("D10:I19") = "0"
Sheets("Active Run").Range("K10:P19") = "0"
Sheets("Active Run").Range("R10:W19") = "0"

MsgBox "Form Cleared"


Else
MsgBox "Canceled."

End If

  Range("D10").Select
  Application.CutCopyMode = False
  
ActiveSheet.Protect "password"
Worksheets("11A Run Data").Protect "password"
Worksheets("11B Run Data").Protect "password"
Worksheets("12A Run Data").Protect "password"
Worksheets("12B Run Data").Protect "password"
Worksheets("13A Run Data").Protect "password"
Worksheets("13B Run Data").Protect "password"

End Sub

CodePudding user response：

Process each worksheet in turn. Loop through the source rows 10 to 19 and calculate the destination column.

Private Sub CommandButton3_Click()

    Const PWD = "password"

    'Time check
    Sheets("Active Run").Activate
    If IsEmpty(Range("D7").Value) = True Then
        MsgBox "No Time Stamp!", vbOKCancel   vbCritical
        Exit Sub
    End If

    'name check
    If InStr(1, (Range("R7").Value), "<Choose one>") > 0 Then
        MsgBox "Select a name from the pull-down menu", vbOKCancel   vbCritical
        Exit Sub
    End If
    
    If MsgBox("This will clear all data!" & vbCr & "Do you wish to proceed?", _
       vbOKCancel   vbExclamation, "Warning!") <> vbOK Then
       Exit Sub
    End If

    Dim ws As Worksheet, wsAR As Worksheet
    Dim ar(1 To 1, 1 To 3), c as Long, r As Long
    Dim lastrow As Long, n As Long, d As Long, k As Long
    Dim rngSrc As Range, rngDest As Range
    
    Set wsAR = Sheets("Active Run")
    With wsAR
        ar(1, 1) = .Range("R7").Value2 ' name
        ar(1, 2) = .Range("AC8").Value2 ' date
        ar(1, 3) = .Range("AD8").Value2 ' time
    End With

    ' sheets 11A,11B,12A,12B,13A,13B
    Application.ScreenUpdating = False
    For n = 11 To 13
        For k = 0 To 1
            Set ws = Sheets(n & Chr(65   k) & " Run Data") 'A is chr(65)
            ws.Unprotect PWD
            lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row   1
            ws.Range("A" & lastrow).Resize(, 3) = ar
            
            ' calc col 11A=D(4) 11B=G(7) 12A=K(11) 12B=N(14) 13A=R(18) 13B=U(21)
            c = 4   (n - 11) * 7   (k * 3)
            For r = 10 To 19
                ' dest cols 10=E(5) 11=H(8) 12=K(11) 13=M(14) etc
                d = 5   (r - 10) * 3
                Set rngSrc = wsAR.Cells(r, c).Resize(, 3)
                Set rngDest = ws.Cells(lastrow, d).Resize(, 3)
                rngDest.Value2 = rngSrc.Value2
                'Debug.Print ws.Name, r, rngSrc.Address, rngDest.Address
            Next
            ws.Protect PWD
        Next
    Next

    With wsAR
        .Unprotect PWD
        .Range("D7") = ""
        .Range("R7") = "<Choose one>"
        .Range("D10:I19,K10:P19,R10:W19") = "0"
        .Protect PWD
        MsgBox "Form Cleared"
    End With
    Application.ScreenUpdating = True
    
    MsgBox "Done", vbInformation
End Sub