I don't see my response (yet). This is a copy.

First, you have some problems with your variables.

The "minor" stuff first.

These lines declare DestWB as a workbook and DestSh as a worksheet.
Dim SrcWB, DestWB As Workbook
Dim SrcSHa, SrcSHb, DestSh As Worksheet

The rest are variants.

You could use:
dim SrcWb as workbook, DestWb as workbook
but I like separate lines. I think it makes it easier to modify (for testing
and for updates!).

Second, you should add:
Option Explicit
to the top of your module.

This tells excel that you want to be forced into declaring your variables.

Then you won't have errors caused by lines like:

DestCell.Offset(0, 3) = SourceSHa.Cells(r, c)

SourceSha should be srcsha (or srcshb???).



I wasn't sure what should happen where, so you'll want to test this extensively!

I was confused by SrcShA and SrcShB. I changed the code to all SrcShA -- I'm
not sure if that's correct.

Option Explicit
Sub ReorgData()

Dim SrcWBa As Workbook
Dim SrcSha As Worksheet
'Dim SrcShb As Worksheet

Dim DestWB As Workbook
Dim DestSh As Worksheet

Dim DestCell As Range
Dim LastCol As Long
Dim LastRow As Long
Dim DestLastRow As Long
Dim c As Long
Dim r As Long

Dim SrcPath As String
Dim DestPath As String

On Error GoTo ErrorCatch

SrcPath = "C:\1-Work\"
DestPath = "C:\1-Work\"

Application.ScreenUpdating = False

Set SrcWBa = Workbooks.Open(SrcPath & "Src.xls")
Set DestWB = Workbooks.Open(DestPath & "Dest.xls")
Set SrcSha = SrcWBa.Worksheets("Sheet1")
'Set SrcShb = SrcWBa.Worksheets("Sheet2")
Set DestSh = DestWB.Worksheets("Sheet1")

' Find next row to Append
With SrcSha
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With

With DestSh
DestLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set DestCell = .Range("A" & DestLastRow)
Set DestCell = DestCell.Offset(1, 0)
End With

For c = 2 To LastCol
For r = 2 To LastRow
' Write DestWB Sheet1
If SrcSha.Cells(r, 1).Value < "Total" Then 'Excludes Total Row
If SrcSha.Cells(r, c) < "" Then
'dates are better handled using .value2
DestCell.value = SrcSha.Cells(1, c).Value2 'A = Date
DestCell.Offset(0, 1).value _
= SrcSha.Cells(1, 1).value 'B=Project
DestCell.Offset(0, 2).value _
= SrcSha.Cells(r, 1).value 'C=Activity
' From "Force" sheet
DestCell.Offset(0, 3).value _
= SrcSha.Cells(r, c).value 'D = Force
' From "Hours" sheet
DestCell.Offset(0, 4).value _
= SrcSha.Cells(r, c).value 'E =Hours
Set DestCell = DestCell.Offset(1, 0)
End If
Else
Exit For 'leave the inside loop
End If
Next r
Next c

With DestSh
.Range("A2").CurrentRegion.Sort _
Key1:=.Range("B2"), Order1:=xlAscending, _
Key2:=Range("A2"), Order2:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
.Range("A:A").Selection.NumberFormat = "m/d/yyyy"
End With

Application.ScreenUpdating = True
SrcWBa.Close SaveChanges:=False
DestWB.Close SaveChanges:=True

Exit Sub

ErrorCatch:
MsgBox Err.Description ' "The sort reference is not valid..........."
Exit Sub

Application.ScreenUpdating = True

End Sub

On 09/29/2010 14:44, u473 wrote:
Thank you, you made my day. It works
.
Last question, why do after the following statements
SrcWBa.Close SaveChanges:=False
DestWB.Close SaveChanges:=True
..When I click X to close, I still have a prompt that asks me
"Do you want to save the changes you made to Dest.xls
and my Source Workbook "Src" is still open.
I thought those statements were taking of closing :
False for do not Save and Close
True for Save and Close
have a good day,
J.P.

--
Dave Peterson