Looking to do a simple copy formula

[Alexpeppard]

My problem is frustrating especially because I know there has to be an easy fix. I have columns of peoples information (name, birthdate ect) and I am looking to print it out. it is formulated like this:

[TABLE="width: 500"]
<tbody>[TR]
[TD]First Name[/TD]
[TD]John[/TD]
[TD]Jane[/TD]
[TD]Jim[/TD]
[TD]ect[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Last Name[/TD]
[TD]Doe[/TD]
[TD]Doe[/TD]
[TD]Doe[/TD]
[TD]ect...[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Birthday[/TD]
[TD]1994[/TD]
[TD]1994[/TD]
[TD]ect[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Birth location[/TD]
[TD]Canada[/TD]
[TD]Canada[/TD]
[TD]ect[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Allergies[/TD]
[TD]None[/TD]
[TD]None[/TD]
[TD]ect[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

But I have 75 people, and many more rows...... What I am looking to do is to repeat Column A but pair it with a different column, such A and B, A and C, A and D, A and E.... ect:

Like this:
[TABLE="width: 500"]
<tbody>[TR]
[TD]First Name[/TD]
[TD]John[/TD]
[/TR]
[TR]
[TD]Last Name[/TD]
[TD]Doe[/TD]
[/TR]
[TR]
[TD]Birthday[/TD]
[TD]1994[/TD]
[/TR]
[TR]
[TD]Birth Place[/TD]
[TD]Canada[/TD]
[/TR]
[TR]
[TD]Allergies[/TD]
[TD]None[/TD]
[/TR]
</tbody>[/TABLE]

[TABLE="width: 500"]
<tbody>[TR]
[TD]First Name[/TD]
[TD]Jane[/TD]
[/TR]
[TR]
[TD]Last Name[/TD]
[TD]Doe[/TD]
[/TR]
[TR]
[TD]Birthday[/TD]
[TD]1994[/TD]
[/TR]
[TR]
[TD]Birth place[/TD]
[TD]Canada[/TD]
[/TR]
[TR]
[TD]Allergies[/TD]
[TD]None[/TD]
[/TR]
</tbody>[/TABLE]


Ect. The point being, I can have everyone's information printed on separate pages


Looking for any help possible.

 

[My Aswer Is This]

Try this:
This script will take your data from Sheet (1) and copy it over to sheet (2) the way you want it.
Remember Sheet(1) is the sheet on the far left side of your tab bar and sheet(2) is next sheet to right.

Sub Test()
Application.ScreenUpdating = False
Dim i As Integer
Dim b As Integer
Dim Lastrow As Long
Dim Lastrowa As Long
Dim LastColumn As Long
Sheets(1).Activate
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Lastrowa = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row
Lastrowb = Sheets(2).Cells(Rows.Count, "B").End(xlUp).Row
LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column

    For b = 2 To LastColumn
        For i = 1 To Lastrow
            Sheets(1).Cells(i, 1).Copy Destination:=Sheets(2).Cells(Lastrowa, 1)
            Sheets(1).Cells(i, b).Copy Destination:=Sheets(2).Cells(Lastrowb, 2)
            Lastrowa = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
            Lastrowb = Sheets(2).Cells(Rows.Count, "B").End(xlUp).Row + 1
        Next
        LastColumn = LastColumn + 1
    Next
Application.ScreenUpdating = True
End Sub

 

[tonyyy]

To add to @MAIT's script, the following will add page breaks so individual information can be "printed on separate pages"...

[COLOR=#808080]    For b = 2 To LastColumn
        For i = 1 To Lastrow
            Sheets(1).Cells(i, 1).Copy Destination:=Sheets(2).Cells(Lastrowa, 1)
            Sheets(1).Cells(i, b).Copy Destination:=Sheets(2).Cells(Lastrowb, 2)
            Lastrowa = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
            Lastrowb = Sheets(2).Cells(Rows.Count, "B").End(xlUp).Row + 1
        Next
        [/COLOR]Sheets(2).Activate
        Sheets(2).Cells(Lastrowb, 2).Select
        ActiveWindow.SelectedSheets.HPageBreaks.Add before:=ActiveCell[COLOR=#808080]
        LastColumn = LastColumn + 1
    Next[/COLOR]

And be sure to add the missing "Dim Lastrowb as Long" statement otherwise the code will generate an error.

Cheers,

tonyyy