Question

我需要将这两组VBA粘贴在同一行而不是一行下面。问题是它们都寻找一个未使用的行，这是必需的，但它们应该在同一个未使用的行上。感谢。

Sub Macro10()
Dim refTable As Variant, trans As Variant
refTable = Array("A = B4", "B = B5", "C = J5")
Dim Row As Long
Row = Worksheets("Customer List").UsedRange.Rows.Count + 1
For Each trans In refTable
Dim Dest As String, Field As String
Dest = Trim(Left(trans, InStr(1, trans, "=") - 1)) & Row
Field = Trim(Right(trans, Len(trans) - InStr(1, trans, "=")))
Worksheets("Customer List").Range(Dest).Value = Worksheets("Order Entry").Range(Field).Value
Next
End Sub

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet

Set copySheet = Worksheets("Order Entry")
Set pasteSheet = Worksheets("Customer List")

copySheet.Range("A8:K22").Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 3).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

以下是调用这两个宏的宏。

Sub SUBMIT()
    Call Macro10
    Call CommandButton1_Click
    Call Check
    Call Macro6
    Call Macro12
End Sub

Answer 1

一种解决方案是创建一个为行提供资金并将其保存为变量的函数。创建一个将行保存为整数的函数，并在两个子函数中使用此值。

 Function findEmptyRow() As Integer
    Row = Worksheets("Customer List").UsedRange.Rows.Count + 1
 End Function

 Sub SUBMIT()
     row = findEmptyRow()
     Call Macro10(row)
     Call CommandButton1_Click(row)
     Call Check
     Call Macro6
     Call Macro12
 End Sub

修改Macro10以便它可以接受变量

Sub Macro10(row As Integer)
Dim refTable As Variant, trans As Variant
refTable = Array("A = B4", "B = B5", "C = J5")

For Each trans In refTable
    Dim Dest As String, Field As String
    Dest = Trim(Left(trans, InStr(1, trans, "=") - 1)) & row
    Field = Trim(Right(trans, Len(trans) - InStr(1, trans, "=")))
    Worksheets("Customer List").Range(Dest).Value = Worksheets("Order Entry").Range(Field).Value
Next

End Sub

然后类似于CommandButton1_Click。这使用了一种不同的方法来查找空行，因此必须稍微调整一下。

Private Sub CommandButton1_Click(row As Integer)
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet

Set copySheet = Worksheets("Order Entry")
Set pasteSheet = Worksheets("Customer List")

copySheet.Range("A8:K22").Copy
pasteSheet.Cells(row, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

粘贴在同一个未使用的行中需要两个VBA代码

1 个答案: