如何将列复制到行中？
如何将列复制到行中？
提问于 2021-12-06 22:03:36
我有几行数据是手动输入的。按下特定的VBA按钮后，将数据传输到另一个工作表，然后对工作表进行密码保护，然后清除表单。
如何将列复制到行中，而不是我想出的版本？
有多个工作表，其中一个带有数据，另一个则需要存档，这取决于输入数据的位置。工作表名是“活动运行”和"11A“、"11B”等。
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回答 1
Stack Overflow用户
回答已采纳
发布于 2021-12-07 14:04:15
依次处理每个工作表。循环遍历源行10至19，并计算目标列。
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页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/70252534
复制相关文章
相似问题
腾讯云开发者
Copyright © 2013 - 2026 Tencent Cloud. All Rights Reserved. 腾讯云 版权所有
深圳市腾讯计算机系统有限公司 ICP备案/许可证号：粤B2-20090059 
粤公网安备44030502008569号
腾讯云计算（北京）有限责任公司 京ICP证150476号 | 京ICP备11018762号