Hi AlphaFrog
Many thanks for taking the time to reply. Here is the full coding supplied by MickG.
Sub MG03Jul47()
Dim Dn As Range
Dim Ws As Worksheet
Dim sht As Worksheet
Dim nRng As Range
Dim nnRng As Range
Dim Col As Integer
Dim Rng As Range
Dim c As Integer
Dim Lst As Long
Dim PstRng As Range
On Error Resume Next
If Sheets("Total_Sheets").Select = False Then
Sheets.Add(after:=Sheets(Sheets.Count)).Name = "Total_Sheets"
End If
On Error GoTo 0
Col = 0
With Sheets("Total_Sheets")
.Cells.ClearContents
.Cells.Interior.ColorIndex = xlNone
.Cells.Borders.LineStyle = xlContinuous
End With
For Each Ws In Worksheets
If Not Ws.Name = "Total_Sheets" And Not Ws.Name = "T_Sheets" Then
With Ws
Set Rng = .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
End With
For Each Dn In Rng
c = c + 1
If IsDate(Dn) Then Exit For
Next Dn
With Sheets("Total_Sheets")
Lst = .Range("A" & .Rows.Count).End(xlUp).Offset(1).Row
Set nRng = Rng.Offset(c - 1).Resize(Rng.Count - c + 1, 3)
nRng.Copy .Range("A" & Lst).Resize(nRng.Rows.Count, 3)
Set nnRng = Rng.Offset(c - 1, 3).Resize(Rng.Count - c + 1, 2)
Set PstRng = .Range("D" & Lst).Offset(, Col).Resize(nnRng.Rows.Count, 2)
.Cells(1, PstRng.Column) = "Debits " & Split(Ws.Name, " ")(1)
.Cells(1, PstRng.Column + 1) = "Credits " & Split(Ws.Name, " ")(1)
nnRng.Copy PstRng
End With
End If
Col = Col + 2
c = 0
Next Ws
With Sheets("Total_Sheets")
.Range("A1").Resize(, 3) = Array("Date", "Account", "Details")
Set Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp)).Resize(, Col)
MsgBox Rng.Address 'Delete as required
With Rng.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 56
End With
Rng.Sort .Range("A2"), xlAscending
.Rows(1).Columns.AutoFit
Rng.Resize(, 3).Columns.AutoFit
End With
Call cula(Rng.Resize(, 1))
MsgBox "Run!!"
End Sub
I don't know why but it takes me to the one before the last column for some reason? Mick has very kindly given up most of his Sunday to help on this so I'm very grateful to him. If I change the Column +2 to Column + 3 is seems to solve it, but puts additional blank columns in the sheet. Any ideas why the range is not going to the end column?
Many thanks for helping. Here is a link to the sample data if it makes it clearer?
http://cl.ly/1l1M0q0p1y0f023Y3N0s
Regards
Kev