thedeadzeds
Active Member
- Joined
- Aug 16, 2011
- Messages
- 442
- Office Version
- 365
- Platform
- Windows
Hi Guys, i have found some code and adapted and it works great. However, i'd like to change it so it does not copy and paste the headers. Can you help?
Thanks
Thanks
VBA Code:
Sub Test()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Table1") '<== Sheet that has raw data
Dim LRow As Long, Found As Range
Dim lastRow As String
Dim lastRow2 As String
lastRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
lastRow2 = Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row
Set Found = ws.Range("A1:HE1").Find("New or Used") '<== Header name to search for
If Not Found Is Nothing Then
LRow = ws.Cells(ws.Rows.Count, Found.Column).End(xlUp).Row
ws.Range(ws.Cells(1, Found.Column), ws.Cells(LRow, Found.Column)).Copy
Sheets("Sheet1").Range("A" & lastRow).PasteSpecial xlPasteValues '<== Sheet to paste data
End If
ws.Activate
ActiveSheet.Select
Set Found = ws.Range("A1:HE1").Find("Total Profit") '<== Header name to search for)
If Not Found Is Nothing Then
LRow = ws.Cells(ws.Rows.Count, Found.Column).End(xlUp).Row
ws.Range(ws.Cells(1, Found.Column), ws.Cells(LRow, Found.Column)).Copy
Sheets("Sheet1").Range("B" & lastRow).PasteSpecial xlPasteValues '<== Sheet to paste data
End If
End Sub