Help on a section of my code, not working

I figured it out Thanks but I now I have a problem with the last part of a new macro

Hello,

The code is working up til the very end. I have 3 sheets (1,2,3) and I have on Sheet 1 data that was brought in from previous macro. So, I now have this macro re-formatting "Sheet1" onto "Sheet2" BUT this range varies for each new file I bring into Sheet1. SO, how do I get the final formatted data on "Sheet2" copied to "Sheet3" and then to keep adding to the next available row on "Sheet3"?????


Sub FormatData()
'**********************************************************
' Clear Sheet 2
'**********************************************************
Sheets("Sheet2").Activate
Cells.Select
Selection.ClearContents
Sheets("Sheet2").Cells(1, 1).Select

'**********************************************************
' Format Sheet
'**********************************************************
Sheets("Sheet2").Cells(1, 1) = "Date"
Sheets("Sheet2").Cells(1, 2) = "Lot"
Sheets("Sheet2").Cells(1, 3) = "Wafer"
Sheets("Sheet2").Cells(1, 4) = "Site"
Sheets("Sheet2").Cells(1, 5) = "Wafer/Site"
Sheets("Sheet2").Cells(1, 6) = "Ring"
Sheets("Sheet2").Cells(1, 7) = "Measurement"
Sheets("Sheet2").Cells(1, 8) = "Value"

'**********************************************************
' Determine number of data columns
'**********************************************************

lngI = 1
Do Until Sheets("Sheet1").Cells(1, lngI + 1) = ""
lngI = lngI + 1
Loop

lngColNum = lngI - 6

'**********************************************************
' Manipulate Data
'**********************************************************

lngRow = 2
lngStartRow = 2
lngEndRow = lngColNum + 1
Do Until Sheets("Sheet1").Cells(lngRow, 1) = "" 'for each row in sheet 1

'Copy the 6 columns of data for this row
For lngI = 1 To 6 '
Sheets("Sheet2").Cells(lngStartRow, lngI) = Sheets("Sheet1").Cells(lngRow, lngI)
Next

'Transpose the data for this row
For lngI = 1 To lngColNum
Sheets("Sheet2").Cells(lngI + lngStartRow - 1, 7) = Sheets("Sheet1").Cells(1, lngI + 6)
Sheets("Sheet2").Cells(lngI + lngStartRow - 1, 8) = Sheets("Sheet1").Cells(lngRow, lngI + 6)
Next

'Fill in empty rows in first 6 columns
For lngI = lngStartRow + 1 To lngEndRow 'for each row
For lngJ = 1 To 6 'for each column
Sheets("Sheet2").Cells(lngI, lngJ) = Sheets("Sheet2").Cells(lngI - 1, lngJ)
Next
Next
lngRow = lngRow + 1
Application.StatusBar = "Working on row " & lngRow
lngStartRow = lngStartRow + lngColNum
lngEndRow = lngStartRow + lngColNum
Loop
Cells.Select
Selection.Columns.AutoFit
Worksheets("Sheet2").Range("A2").Select
'*******THIS IS MY problem NOW********************************************
Range(Selection, Selection.End(xlToRight)).Select_
Range(Selection, Selection.End(xlToDown)).Select
Selection.Copy
Active.Worksheets("Sheet3").Cells(Rows.Count, "A").End (xlUp)
ActiveSheet.Paste
'Worksheets("Sheet2").Range("A2:H10922").Copy Destination:=Worksheets("Sheet3").Cells(Rows.Count, "A").End(xlUp)
Application.StatusBar = False


End Sub


TThanks,
Irene