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

Question

I hope someone can help me, I need a button in Excel 2013 to carry out the following commands:

1. In "Sheet1" the range "A2:I2" is copied.
2. The value in A2 is looked up to determine an appropriate worksheet, which is activated and the copied range is pasted into the next available row in the range of B:J.
3. Once the data is pasted, the value of the cell in column A in the pasted row of the activated worksheet is returned to the user.

So for example:

When I input into Sheet1.A2 "technical report", and click on my button, it would copy Sheet1.A2:I2, then lookup the worksheet called "TEC", activate it, and paste the data into TEC.B2:I2.

In my "TEC" sheet, I have a pre-existing list of numbers in column A. When a data range is copied into TEC.B5:I5, the value of TEC.A5 is looked up and returned to the user (who is locked out of TEC and only has access to Sheet1).

Importantly, every time this happens, the data must be pasted into a new row, and therefore a new number is returned to the user.

---

I know this is a lot to ask but I have been trying to use bits of code with no results and I am not a very advanced VBA user so any help provided here would be really appreciated!

Code so far is:

 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 

Answer 1

In general I don't like to use copy/paste in VBA but rather assign values to ranges. This way you don't have to move back and forth between sheets. The following will work assuming you have a header row in each worksheet you are moving data to (since rowCount is never returned as zero).

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