ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Worksheet Functions (https://www.excelbanter.com/excel-worksheet-functions/)
-   -   How Excel help to reproduce a form like this (https://www.excelbanter.com/excel-worksheet-functions/137842-how-excel-help-reproduce-form-like.html)

GY Fong - HK

How Excel help to reproduce a form like this
 
I want to generate a new form.
Sheet1:
Staff Att'd. Date Post JOB
CHAN 01-04-07 PA R8
WONG 01-04-07 PB IC
CHAN 01-05-07 PA IC
LEE 01-06-07 PC SP
CHAN 01-07-07 PA SP

TO THIS NEW FORM (Sheet2):
STAFF: CHAN POST: PA
DATE: JOB
01-04-07 R8
01-05-07 IC
01-07-07 SP

Thanks
GY


Bob Phillips

How Excel help to reproduce a form like this
 
Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim iLastRow As Long
Dim iNextRow As Long
Dim sh As Worksheet

With ActiveSheet

iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 2 To iLastRow
Set sh = Nothing
On Error Resume Next
Set sh = Worksheets(.Cells(i, "A").Value)
On Error GoTo 0
If sh Is Nothing Then
Set sh = Worksheets.Add(after:=Worksheets(Worksheets.Count) )
sh.Name = .Cells(i, "A").Value
sh.Range("A1").Value = _
"STAFF: " & .Cells(i, "A").Value & " POST:" & .Cells(i,
"C").Value
sh.Range("A2").Value = "DATE:"
sh.Range("B2").Value = "POST"
iNextRow = 3
Else
iNextRow = sh.Cells(Rows.Count, "A").End(xlUp).Row + 1
End If
.Cells(i, "B").Copy sh.Cells(iNextRow, "A")
.Cells(i, "D").Copy sh.Cells(iNextRow, "B")
Next i

End With

End Sub

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

"GY Fong - HK" wrote in message
...
I want to generate a new form.
Sheet1:
Staff Att'd. Date Post JOB
CHAN 01-04-07 PA R8
WONG 01-04-07 PB IC
CHAN 01-05-07 PA IC
LEE 01-06-07 PC SP
CHAN 01-07-07 PA SP

TO THIS NEW FORM (Sheet2):
STAFF: CHAN POST: PA
DATE: JOB
01-04-07 R8
01-05-07 IC
01-07-07 SP

Thanks
GY





All times are GMT +1. The time now is 08:50 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com