Dim LstHdrRow As Long, LstSrcRow As LongDim LstHdrCol As Long, LstSrcCol As Long, LstRptCol As Long
Dim HdgCol As Long
Dim SrcSht As Worksheet, RptSht As Worksheet
Dim HdgHdrs As Range, SrcHdrs As Range, RptHdrs As Range
Set SrcSht = Sheets("Source")
Set RptSht = Sheets("Report")
HdgCol = 1 'Column containing headers on the Headings sheet
LstHdrRow = Sheets("Headings").Cells(Rows.Count, HdgCol).End(xlUp).Row
LstSrcRow = Sheets("Source").Cells.Find("*", searchorder:=xlByRows, SearchDirection:=xlPrevious).Row
LstHdrCol = Sheets("Headings").Cells(Rows.Count, HdgCol).End(xlUp).Offset(-1, 0).Row
LstRptCol = Sheets("Headings").Cells(Rows.Count, HdgCol).End(xlUp).Offset(-1, 0).Row
LstSrcCol = Sheets("Source").Cells.Find("*", searchorder:=xlByColumns, SearchDirection:=xlPrevious).Column
Set HdgHdrs = Sheets("Headings").Range(Sheets("Headings").Cells(2, HdgCol), Sheets("Headings").Cells(LstHdrRow, HdgCol))
Set SrcHdrs = Sheets("Source").Range(Sheets("Source").Cells(1, 1), Sheets("Source").Cells(1, LstSrcCol))
RptSht.Range(RptSht.Cells(1, 1), RptSht.Cells(1, LstHdrCol)) = WorksheetFunction.Transpose(HdgHdrs)
'Set Report Headers
Dim RptRef As Long, RptTtl As Long, RptInt As Long, RptFor As Long, RptSur As Long, RptGen As Long
Dim RptAd1 As Long, RptAd2 As Long, RptAd3 As Long, RptAd4 As Long, RptTwn As Long, RptCot As Long
Dim RptPst As Long, RptTel As Long, RptMob As Long, RptEml As Long, RptUrl As Long
Dim RptRsn As Long, RptFun As Long, RptLed As Long, RptEvt As Long, RptSft As Long
Dim RptQ1 As Long, RptQ2 As Long, RptQ3 As Long, RptQ4 As Long, RptQ5 As Long
RptRef = RptHdrs.Find("URN", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
RptTtl = RptHdrs.Find("Title", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
RptFor = RptHdrs.Find("Forename", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
RptSur = RptHdrs.Find("Surname", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
RptAd1 = RptHdrs.Find("Address 1", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
RptAd2 = RptHdrs.Find("Address 2", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
RptAd3 = RptHdrs.Find("Address 3", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
RptAd4 = RptHdrs.Find("Address 4", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
RptTwn = RptHdrs.Find("Town", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
RptCot = RptHdrs.Find("County", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
RptPst = RptHdrs.Find("Postcode", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
RptTel = RptHdrs.Find("Phone", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
RptMob = RptHdrs.Find("Mobile", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
RptEml = RptHdrs.Find("E-mail", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
RptUrl = RptHdrs.Find("Website", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
RptRsn = RptHdrs.Find("Financial Reason", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
RptFun = RptHdrs.Find("Financial Fund", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
RptLed = RptHdrs.Find("Financial Ledger", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
RptEvt = RptHdrs.Find("Event Number", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
RptSft = RptHdrs.Find("Credit", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
RptQ1 = RptHdrs.Find("Query1", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
RptQ2 = RptHdrs.Find("Query2", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
RptQ3 = RptHdrs.Find("Query3", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
RptQ4 = RptHdrs.Find("Query4", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
RptQ5 = RptHdrs.Find("Query5", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
'Set Source Headers
Dim SrcPge As Long, SrcDat As Long, SrcDsc As Long, SrcNme As Long, SrcTtl As Long, SrcFor As Long
Dim SrcSur As Long, SrcDob As Long, SrcAd1 As Long, SrcAd2 As Long, SrcTwn As Long
Dim SrcCot As Long, SrcPst As Long, SrcEml As Long, SrcUrl As Long, SrcTel As Long
Dim SrcRef As Long, SrcFun As Long, SrcLed As Long, SrcEvt As Long, SrcSft As Long
SrcPge = SrcHdrs.Find("Page ID", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
SrcDat = SrcHdrs.Find("Created Date", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
SrcDsc = SrcHdrs.Find("Description", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
SrcNme = SrcHdrs.Find("Page Name", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
SrcTtl = SrcHdrs.Find("Title", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
SrcFor = SrcHdrs.Find("Forename", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
SrcSur = SrcHdrs.Find("Surname", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
SrcDob = SrcHdrs.Find("Date of Birth", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
SrcAd1 = SrcHdrs.Find("Address Line 1", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
SrcAd2 = SrcHdrs.Find("Address Line 2", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
SrcTwn = SrcHdrs.Find("Address Line 3", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
SrcCot = SrcHdrs.Find("Address Line 4", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
SrcPst = SrcHdrs.Find("Postcode", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
SrcEml = SrcHdrs.Find("Email Address", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
SrcUrl = SrcHdrs.Find("URL", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
SrcTel = SrcHdrs.Find("Telephone Number", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
SrcRef = SrcHdrs.Find("Custom ID", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
SrcFun = SrcHdrs.Find("Fund", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
SrcLed = SrcHdrs.Find("Ledger", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
SrcEvt = SrcHdrs.Find("Event", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
SrcSft = SrcHdrs.Find("Credit", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
'------------------
'misc formatting code e.g.
'
'
'Dim TwnRow As Long
'For TwnRow = 2 To LstSrcRow
' RptSht.Cells(TwnRow, RptTwn) = UCase(SrcSht.Cells(TwnRow, SrcTwn).Value)
'Next TwnRow
'Dim CotRow As Long
'For CotRow = 2 To LstSrcRow
' RptSht.Cells(CotRow, RptCot) = Application.Proper(SrcSht.Cells(CotRow, SrcCot).Value)
'Next CotRow
'
'
'------------------
Dim ColNum As Long
For ColNum = LstRptCol To 1 Step -1
If WorksheetFunction.CountA(RptSht.Range(RptSht.Cells(2, ColNum), RptSht.Cells(LstSrcRow, ColNum))) = 0 Then
RptSht.Columns(ColNum).Delete
End If
Next
Sheets("Report").Move