Want to add additional columns to attached macro

Hi,

Can someone help please. I don't know how to add addtional columns to the attached macro. At the moment when I run macro it provides me with one column of data with a heading. Want to add an extra four columns. The titles of columns can be col2, col3, col4 and col6.

Many thanks.

Sub ListTraining()
Dim LastRow As Long, i As Long, StartRow As Long, NameCol As Integer
Dim ISh As Worksheet, OSh As Worksheet, j As Long
StartRow = 2
NameCol = 1
Set ISh = ActiveSheet
LastRow = ISh.Cells(Rows.Count, NameCol).End(xlUp).Row
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Need Training").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Need Training"
Set OSh = Sheets("Need Training")
OSh.Cells(1, 1).Value = "Training overdue for Manual Handling"
j = 1
For i = StartRow To LastRow
If IsEmpty(ISh.Cells(i, NameCol + 1).Value) Then
j = j + 1
OSh.Cells(j, 1).Value = ISh.Cells(i, NameCol).Value
End If
Next i
OSh.Columns(1).EntireColumn.AutoFit
End Sub

Hi

To add the extra headings change the line

OSh.Cells(1, 1).Value = "Training overdue for Manual Handling"

to

OSh.Range("A1:E1").Value = Array("Training overdue for Manual Handling", "col2", "col3", "col4", "col6")

If you want to add extra columns of data to the output, which columns from the source sheet do you want to copy over?


rylo

Rylo,

The additional data is found in column B'C'F'L.

Apologies for cross posting didn't know post got copied to other sites.

Hi

Try changing

OSh.Cells(j, 1).Value = ISh.Cells(i, NameCol).Value

to

OSh.Cells(j, 1).Value = ISh.Cells(i, NameCol).Value
osh.cells(j,2).value = ish.cells(i,2).value 'B
osh.cells(j,3).value = ish.cells(i,3).value 'C
osh.cells(j,4).value = ish.cells(i,6).value 'F
osh.cells(j,5).value = ish.cells(i,12).value 'L

rylo