Macro to Generate Customised Report

[kaffal]

Hi all, I wan to generate a customised report based on a Workbook(Data).
In the data workbook, there are up to 25 headers, could be more or less depend on the report recieved. The headers are found in row3.

However I wan to create a customised report to several parties.

- First When I run the macro, It will list out all the heading in a form, found in row 3, B2 onward. The number of headers may varies. In the form, I am able to select which headers I wan to include in the customsed report.

- After selecting the selected headers, It will copy the data found below the headers.

- It will copy to my customised report workbook.

Example: Those colored heading are those

Excel Workbook
	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
3	Header1	Header2	Header3	Header4	Header5	Header6	Header7	Header8	Header9	Header10	Header11	Header12	Header13	Header14	Header15
4	Data 1	Data 2	Data 3	Data 4	Data 5	Data 6	Data 7	Data 8	Data 9	Captured	Data 11	Data 12	Data 13	Data 14	Data 15
5	Data 2	Data 4	Data 5	Data 6	Data 7	Data 8	Data 9	Data 10	Data 11	Captured	Data 13	Data 14	Data 15	Data 16	Data 17
6
7	Num1	Num2	Num3	Num4	Num5	Num6	Num7	Num8	Num9	Generated	Num11	Num12	Num13	Num14	Num15
8	Info3	Info4	Info5	Info6	Info7	Info8	Num8	Info10	Info11	Generated	Info13	Info14	Info15	Num15	Num16
9	Info4	Info5	Num7	Num8	Num9	Num10	Num9	Num12	Num13	Generated	Num15	Num16	Num17	Num16	Num17
Data WorkBook

Customised Report

Excel Workbook
	B	C	D	E	F	G	H	I	J	K
3	Header1	Header2	Header3	Header4	Header6	Header7	Header10	Header11	Header12	Header15
4	Data 1	Data 2	Data 3	Data 4	Data 6	Data 7	Captured	Data 11	Data 12	Data 15
5	Data 2	Data 4	Data 5	Data 6	Data 8	Data 9	Captured	Data 13	Data 14	Data 17
6
7	Num1	Num2	Num3	Num4	Num6	Num7	Generated	Num11	Num12	Num15
8	Info3	Info4	Info5	Info6	Info8	Num8	Generated	Info13	Info14	Num16
9	Info4	Info5	Num7	Num8	Num10	Num9	Generated	Num15	Num16	Num17
Report WorkBook

 

[kgkev]

If you colour the cells yellow this will copy just those columns to the "Report" sheet

SHEET NAME = "DATA"
SHEET NAME = "REPORT"

Sub generatereport()

Dim rng As Range

Set rng = Sheets("Data").Range("A1", Sheets("Data").Range("Z1").End(xlToLeft))

For Each Item In rng
    If Item.Interior.ColorIndex = 6 Then
        Item.EntireColumn.Copy Destination:=Sheets("Report").Range("Z1").End(xlToLeft).Offset(, 1)
    End If
    
Next Item
    

End Sub

 

[kgkev]

improvement

Sub generatereport()
Sheets("report").Cells.ClearContents
Dim rng As Range

Set rng = Sheets("Data").Range("A1", Sheets("Data").Range("Z1").End(xlToLeft))

For Each Item In rng
    If Item.Interior.ColorIndex = 6 Then
        Item.EntireColumn.Copy Destination:=Sheets("Report").Range("Z1").End(xlToLeft).Offset(, 1)
        Sheets("Report").Range("Z1").End(xlToLeft).Interior.ColorIndex = xlAutomatic
    End If
    
Next Item
    
Columns("A:A").Delete Shift:=xlToLeft
End Sub

 

[kaffal]

actually i highlight yellow is to show that I wan those headers to be copied.
How I select which headers to copied over is done on a form listing all the headers . if the checkbox beside the respective headers is ticked, it will be copied.