Thread: VBA Code shouldn't export header information

Hello,

I got awesome code from your site , but would need still a little assistance with it.
The code below works great. It exports pivot details to new sheet with timestamps and all that. But there is two things I would need still :

1) I would like that headers wouldn't be exported at all.
2) I created a drop down box for different waste codes on the sheet "TOY Mill Stocks".
That information should be copied to waste_proposals.xls next to the time stamp.

EDIT : The waste code that is selected from the combo box, is fetched with index-formula to cell K13...if this information is needed.

Hopefully you can help me.

Code here :

Sub Hylkyehdotus()
    Dim rngArea As Range
    Dim strPath As String
    Dim vData As Variant
    On Error GoTo Handler
    If MsgBox("Are you really sure you want to make a Waste Proposal of items you selected", vbYesNo, "Confirm") = vbNo Then
    MsgBox "Action Cancelled", vbInformation, "Abort"
    Exit Sub
End If
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    strPath = "\\server01\yhteiset\WasteProposals\Waste_proposals.xls"
    With Sheets("TOY Mill Stocks").PivotTables("PivotTable2").TableRange2
        .Cells(.Cells.Count).ShowDetail = True
         For Each rngArea In Range("B:B,E:E,G:G,J:J,L:P,R:R,T:AP,AR:AZ").Areas
            rngArea.Delete
        Next rngArea
               vData = ActiveSheet.UsedRange
        Workbooks.Open strPath, WriteResPassword:="riivattu", IgnoreReadOnlyRecommended:=True
        
        With Sheets("Wasteproposals")
            With .Cells(.Rows.Count, "A").End(xlUp).Offset(2)
                .Resize(UBound(vData, 1), UBound(vData, 2)) = vData
                With .Offset(1, 20).Resize(3)
                    .Value = Application.Transpose(Array("Timestamp:", "Username", "Computer Name"))
                    .Offset(, 1).Value = Application.Transpose(Array(Now, Environ("username"), Environ("computername")))
                End With
            End With
        End With
        ActiveWorkbook.Close True
        ActiveSheet.Delete
    End With
    MsgBox "Waste Proposal Complete " & vbLf & vbLf & "Updated File Location: " & strPath, vbInformation, "Complete"
ExitPoint:
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    Exit Sub
    
Handler:
    MsgBox "Error Has Occurred" & vbLf & vbLf & _
        "Error Number: " & Err.Number & vbLf & vbLf & _
        "Error Desc.: " & Err.Description, _
        vbCritical, _
        "Fatal Error"
    Resume ExitPoint
End Sub

- Jyri

This code will select A2 to the last used range in a cell.
So if row 1 is your headings, it won't get copied

    Dim Rws As Long, Col As Integer, r As Range, fRng As Range

    Set r = Range("A1")

    Rws = Cells.Find(What:="*", After:=r, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    Col = Cells.Find(What:="*", After:=r, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column


    Set fRng = Range(Cells(2, 1), Cells(Rws, Col))    ' range A2 to last cell on sheet

    fRng.Select    'or whatever you want to do with the range