dpaton05
Well-known Member
- Joined
- Aug 14, 2018
- Messages
- 2,392
- Office Version
- 365
- 2016
- Platform
- Windows
I have 2 workbooks and both have an excel table. I have a button that is meant to copy data from one table (npss_quote) to the other table (tblCosting) but it is transposing the values. I have 1 row in the first table (npss_quote), which is in the workbook with the code. Above npss_quote is several fields relating to each row in the table. The code is meant to copy each row from the npss_quote to tblCosting but also to copy the fields above the table and for them to be the same for every row in npss_quote.
I have 1 row in npss_quote which becomes 2 rows in tblCosting. Columns E and H stay in the first row for the row but all the rest of the columns are pushed down to the next row.
Can someone help me with this code please as I am still learning to code and someone wrote this for me?
Thanks,
Dave
I have 1 row in npss_quote which becomes 2 rows in tblCosting. Columns E and H stay in the first row for the row but all the rest of the columns are pushed down to the next row.
Can someone help me with this code please as I am still learning to code and someone wrote this for me?
Code:
Private Sub CmdSend_Click()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim desWS As Worksheet
Dim srcWS As Worksheet
Set srcWS = ThisWorkbook.Sheets("NPSS_quote_sheet")
Set desWS = Workbooks("Costing tool.xlsm").Sheets("Home")
Dim lastRow1 As Long
Dim lastRow2 As Long
lastRow1 = srcWS.Range("B" & srcWS.Rows.Count).End(xlUp).Row
lastRow2 = desWS.Range("A" & srcWS.Rows.Count).End(xlUp).Row
Dim i As Long
Dim header As Range
Dim x As Long
With srcWS.Range("A:A,B:B,H:H")
For i = 1 To .Areas.Count
x = .Areas(i).Column
Set header = desWS.Rows(4).Find(.Areas(i).Cells(10), LookIn:=xlValues, lookat:=xlWhole)
If Not header Is Nothing Then
srcWS.Range(srcWS.Cells(11, x), srcWS.Cells(lastRow1, x)).Copy
desWS.Cells(lastRow2 + 1, header.Column).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End If
Next i
End With
With desWS
.Range("D" & lastRow2 + 1 & ":D" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("G7")
.Range("F" & lastRow2 + 1 & ":F" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("B7")
.Range("G" & lastRow2 + 1 & ":G" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("B6")
End With
With Application
.CutCopyMode = False
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
Thanks,
Dave