Диапазон транспонирования
В pasteSheet у вас есть данные до и между обработанными столбцами.Если вы не будете добавлять эти столбцы в этот код, и если они не рассчитываются при обработке столбца, вы должны заменить каждый ', 1' (который вычисляет последнюю строку в столбце 1 ("A")) на соответствующий столбецномер или код будет вставлен всегда в одной строке.В этом случае первый обработанный столбец - это столбец 3 (C).
Быстрое обновление
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
Улучшенная версия
У вас есть много значений, которые должны быть в константах наначало кода, чтобы вы могли быстро изменить их.В следующем коде измените столбец cVntLastRowColumn соответствующим образом по причинам, упомянутым ранее в версии быстрого обновления.
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
Если это понятие источника и цели слишком запутанное, вы можете изменить все переменные, просто переименоваввсе вхождения источника для копирования и цели для вставки.