How to copy values based on multiple cell criteria to another Sheet

Question

I have an input range (F9:F58) in sheet "Form", and I need to copy those input values to table in another sheet "Databased" based on multiple criteria (E2) & (E6) in sheet "Form". Note: the condition destination table of input values is in specific column.

Public Sub InputUnload()

    Set copysheet = Sheets("Form")
    Set pasteSheet = Sheets("Databased")

    pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = _
    copysheet.Range("E2").Value
    pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(0, 1) = _
    copysheet.Range("E6").Value

    pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(0, 1) _
            .PasteSpecial xlPasteValues, Transpose:=True _
            = copysheet.Range("F9:F58").Value

End Sub

"Form" Sheet

"Databased" sheet

Thanks in advance.

Answer 1

Transpose Range

In pasteSheet you have data before and in between the columns processed. If you won't be adding those columns into this code and if they aren't calculated when processing column you should change each ', 1' (which is calculating the last row in column 1 ("A")) to the appropriate column number or the code will paste always in the same row. In this case the first column processed is column 3 (C).

Quick Update

Sub InputUnload()

    Dim copySheet As Worksheet
    Dim pasteSheet As Worksheet
    Dim vntRange As Variant
    Dim lastRow As Long

    Set copySheet = Sheets("Form")
    Set pasteSheet = Sheets("Databased")

    ' Calculate last row of data.
    lastRow = pasteSheet.Cells(Rows.Count, 1).End(xlUp).Row

    ' Copy 2 cells.
    pasteSheet.Cells(lastRow + 1, 1).Offset(0, 2) = copySheet.Range("E2").Value
    pasteSheet.Cells(lastRow + 1, 1).Offset(0, 4) = copySheet.Range("E6").Value

    ' Paste column range into array.
    vntRange = copySheet.Range("F9:F58").Value

    ' Paste transpose array into row range.
    pasteSheet.Cells(lastRow + 1, 1).Offset(0, 5).Resize(, copySheet _
            .Range("F9:F58").Rows.Count).Value = Application.Transpose(vntRange)

End Sub

Improved Version

You have many values that should be in constants at the beginning of the code so you could quickly change them. In the following code adjust the column cVntLastRowColumn appropriately for the reasons previously mentioned in the Quick update version.

Sub InputUnload()

    ' Source
    Const cStrSource As Variant = "Form"        ' Source Worksheet Name/Index
    Const cStrDate As String = "E2"             ' Date Cell Range Address
    Const cStrSalesman = "E6"                   ' Salesman Cell Range Address
    Const cStrRange = "F9:F58"                  ' Source Column Range Address
    ' Target
    Const cStrTarget As Variant = "Databased"   ' Target Worksheet Name/Index
    Const cVntLastRowColumn As Variant = 1      ' Last Row Column Letter/Number
    Const cVntDateColumn As Variant = 3         ' Date Column Letter/Number
    Const cVntSalesmanColumn As Variant = 5     ' Salesman Column Letter/Number
    Const cVntFirstColumn As Variant = 6        ' First Column Letter/Number

    Dim objSource As Worksheet   ' Source Worksheet
    Dim objTarget As Worksheet   ' Target Worksheet
    Dim vntRange As Variant      ' Source Range Array
    Dim lngLastRow As Long       ' Target Last Row Number

    Set objSource = Sheets(cStrSource)  ' Create reference to Source Worksheet.
    Set objTarget = Sheets(cStrTarget)  ' Create reference to Target Worksheet.

    ' Calculate Target Last Row Number in Target Worksheet.
    lngLastRow = objTarget.Cells(Rows.Count, cVntLastRowColumn).End(xlUp).Row

    ' Copy Date Cell Range value to Target Worksheet.
    objTarget.Cells(lngLastRow + 1, cVntDateColumn) _
            = objSource.Range(cStrDate).Value

    ' Copy Salesman Cell Range value to Target Worksheet.
    objTarget.Cells(lngLastRow + 1, cVntSalesmanColumn) _
            = objSource.Range(cStrSalesman).Value

    ' Paste Source Column Range into Source Array.
    vntRange = objSource.Range(cStrRange).Value

    ' Paste transpose Source Array into Target Row Range
    ' starting from First Column.
    objTarget.Cells(lngLastRow + 1, cVntFirstColumn) _
            .Resize(, objSource.Range(cStrRange).Rows.Count) _
            = Application.Transpose(vntRange)

End Sub

If this concept of Source and Target is too confusing you can change all the variables by simply renaming all occurrences of Source to Copy and of Target to Paste.