Question

我希望有人可以帮助我，我需要在Excel 2013中使用一个按钮来执行以下命令：

In＆＃34; Sheet1＆＃34;范围＆＃34; A2：I2＆＃34;被复制。
查找A2中的值以确定适当的工作表，该工作表已激活，复制的范围将粘贴到B：J范围内的下一个可用行中。
粘贴数据后，激活的工作表的粘贴行中A列中的单元格值将返回给用户。

例如：

当我输入Sheet1.A2＆＃34;技术报告＆＃34;，然后点击我的按钮时，它会复制Sheet1.A2：I2，然后查找名为＆＃34; TEC＆＃34;的工作表，激活它，并将数据粘贴到TEC.B2：I2。

在我的＆＃34; TEC＆＃34;表，我在A列中有一个预先存在的数字列表。当数据范围被复制到TEC.B5：I5时，TEC.A5的值被查找并返回给用户（被锁定在TEC之外的用户）只能访问Sheet1）。

重要的是，每次发生这种情况时，必须将数据粘贴到新行中，因此会向用户返回一个新数字。

我知道这有很多要问，但我一直在尝试使用一些没有结果的代码，而且我不是一个非常高级的VBA用户，所以这里提供的任何帮助都会非常感激！

代码是：

＆＃13;

Sub button()

Application.CutCopyMode = False

Sheets("sheet1").Range("A2:I2").Copy                          'copy document data
If Sheets("Sheet1").Range("A2") = "Technical Report" Then
Sheets("TEC").Activate                                            ' check for type of document and activate relevant document worksheet
                  
ElseIf Sheets("Sheet1").Range("A2") = "Engineering Coordination Memo" Then
Sheets("ECM").Activate

ElseIf Sheets("Sheet1").Range("A2") = "Critical Design Review" Then
Sheets("CDR").Activate

ElseIf Sheets("Sheet1").Range("A2") = "Preliminary Design Review" Then
Sheets("PDR").Activate

ElseIf Sheets("Sheet1").Range("A2") = "Qualification by Similarity and Analysis" Then
Sheets("QSR").Activate

ElseIf Sheets("Sheet1").Range("A2") = "Qualification by Test Procedure" Then
Sheets("QTP").Activate

ElseIf Sheets("Sheet1").Range("A2") = "Reliability Report" Then
Sheets("REL").Activate

ElseIf Sheets("Sheet1").Range("A2") = "Specification Compliance Tabulation" Then
Sheets("SCT").Activate

End If




 Dim sourceCol As Integer, rowCount As Integer, currentRow As Integer   'code to select next empty cell in coumn B
    Dim currentRowValue As String

    sourceCol = 2   'column B has a value of 2
    rowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row

    'for every row, find the first blank cell and select it
    For currentRow = 1 To rowCount
        currentRowValue = Cells(currentRow, sourceCol).Value
        If IsEmpty(currentRowValue) Or currentRowValue = "" Then
            Cells(currentRow, sourceCol).Select
            Exit For
        End If
    Next



Paste

 ActiveCell.Offset(columnoffset:=-1).Select
 Copy
 Sheets("Sheet1").Activate
 Sheets("Sheet1").Range("A5").Paste
 

End Sub

＆＃13;

Answer 1

一般情况下，我不想在VBA中使用复制/粘贴，而是将值分配给范围。这样你就不必在两张纸之间来回移动。假设您在将数据移动到的每个工作表中都有一个标题行，以下内容将起作用（因为rowCount永远不会返回为零）。

Sub button()

    Dim sheetName As String

    If Sheets("Sheet1").Range("A2") = "Technical Report" Then
    sheetName = "TEC"   ' check for type of document and activate relevant document worksheet

    ElseIf Sheets("Sheet1").Range("A2") = "Engineering Coordination Memo" Then
    sheetName = "ECM"

    ElseIf Sheets("Sheet1").Range("A2") = "Critical Design Review" Then
    sheetName = "CDR"

    ElseIf Sheets("Sheet1").Range("A2") = "Preliminary Design Review" Then
    sheetName = "PDR"

    ElseIf Sheets("Sheet1").Range("A2") = "Qualification by Similarity and Analysis" Then
    sheetName = "QSR"

    ElseIf Sheets("Sheet1").Range("A2") = "Qualification by Test Procedure" Then
    sheetName = "QTP"

    ElseIf Sheets("Sheet1").Range("A2") = "Reliability Report" Then
    sheetName = "REL"

    ElseIf Sheets("Sheet1").Range("A2") = "Specification Compliance Tabulation" Then
    sheetName = "SCT"
    End If

    Dim rowCount As Integer
    Dim sourceCol As Integer

    sourceCol = 2   'column B has a value of 2

    With Sheets(sheetName)
        rowCount = .Cells(Rows.Count, sourceCol).End(xlUp).Row
        .Range("B" & rowCount + 1 & ":I" & rowCount + 1) = Sheets("Sheet1").Range("B2:I2").Value
    End With

    Sheets("Sheet1").Range("A5") = Sheets(sheetName).Range("A" & rowCount + 1).Value

End Sub

使用VBA和表单按钮复制并粘贴Excel 2013

1 个答案: