VBA Merge/Consolidation problem

[KWMKWM]

Hi, I need some expert excel VBA help, just a beginner.

I have some code I've gotten to work 95%...but the last
5% is killing me.

What I'm trying to do at a high level is do a data merge based
on the column header.

As an example, the user would have a workbook with 4 sheets,
3 with data and 1 as a consolidation of the others.


I've done an input screen that looks like
this...the user enters the header text and
the destination sheet where the headers
have already been built...the value of
'header text' is 'Table' on the first
pass and then the user enters 'Colors'
on the 2nd pass.

*******************************
* *
* destination sheet [sheet4_] *
* *
* header text [Table ] *
* *
*******************************

sheet1 would look like this:

A.................B................C.....................Comment
1 Table.............................Colors..............(header row)
2 Rule1A..........................red1A...............(data rows )
3 Rule1B..........................white1B
4 Rule1C..........................blue1C


sheet2 would look like this:

...A ...............B...................C............D..................Comment
1...................Table............................Colors............(header row)
2...................Rule2A.........................red2A.............(data rows )
3...................Rule2B.........................white2B
4...................Rule2C.........................blue2C

sheet3 would look like this:

...A................B.............C...............D.............E.................Comment
1.................................Table.........................Colors............(header row)
2.................................Rule3A......................red3A ............(data rows )
3.................................Rule3B......................white3B
4.................................Rule3C......................blue3C

sheet 4 is the consolidation sheet and would
look like this:

...A..................B.........Comment
1 Table Colors (header row)
2 Rule1A red1A (data rows )
3 Rule1B white1B
4 Rule1C blue1C
5 Rule2A red2A
6 Rule2B white2B
7 Rule2C blue2C
8 Rule3A red3A
9 Rule3B white3B
10 Rule3C blue3C

I've gotten the code to the point where it
ALMOST does this...but this is what I get in
sheet4 instead

...A...................B................Comment
1..Table............Colors..........(header row)
2..Rule1A............................(data rows )
3 Rule1B
4 Rule1C
5 Rule2A
6 Rule2B
7 Rule2C
8 Rule3A
9 Rule3B
10 Rule3C
11.....................red1A
12.....................white1B
13.....................blue1C
14.....................red2A
15.....................white2B
16.....................blue2C
17.....................red3A
18.....................white3B
19.....................blue3C


As you can see, the first pass (Tables)
is fine, but then subsequent passes
keep the correct column but start at the
end of the worksheet data row, not the
column data row which is what I want.

Does anyone have a clue? I've spent a
long time on this last piece and am
getting nowhere so far.

Thanks
Kevin

==========code==============

Private Sub Cancel_Click()
  result = False
  Unload Me
End Sub

Private Sub Copy_Click()
   Dim rng As Range
     Dim row As Long
     With ActiveSheet

     Do

       For i = 1 To Sheets.Count - 1
       ksheets = Sheets(i).Name

       Set rng = Sheets(ksheets).Range("A1:XFD1").Find(what:=headerText, LookIn:=xlValues)
       rng.Offset(1, 0).Resize(rng.End(xlDown).row - 1).Copy
       Set rng = Sheets("Sheet4").Range("A1:XFD1").Find(what:=headerText, LookIn:=xlValues)


       row = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row


       columnNumber = rng.Column

       If columnNumber > 26 Then
         ColumnLetter = Chr(Int((columnNumber - 1) / 26) + 64) & _
         Chr(((columnNumber - 1) Mod 26) + 65)
       Else
         ColumnLetter = Chr(columnNumber + 64)
       End If

       rng.Offset(row, col).PasteSpecial (xlPasteAll)

      Next i

     Loop Until ksheets = "Sheet3"

End With


End Sub

Private Sub headerText_Change()

End Sub

Private Sub UserForm_Click()
MsgBox ("Use this function to copy and consolidate columns to a master worksheet")
End Sub

Private Sub UserForm_Initialize()
destinationText.Text = "Sheet4"
headerText.Text = "Table"
rowtrack = 0
End Sub

[/FONT]