Hi I have completed my code and it is working just as I want other than one
small problem.

The code cuts a month off the top of the sheet and places it into an open
file keeping the file size down in the main file.

The code then adds using autofill another month to the end of the sheet to
expand the range of cells available for further entry.

I need to make the cut cells go into tabs named the same as they are in the
main document.

I would have to alter this line to say match source with destination sheet.

Set wsArchive = Workbooks("Archive.xls").Sheets(1)


If it is not possible to do this I could give all exported rows an added
column which is named for each row the same as the tab it was exported from.
This way I could sort the entries into tabs easily in the destination file.


Sub Addrows_Click()

Dim mnthlgth As Long
Dim iLastRow As Long
Dim wsArchive As Worksheet

Set wsArchive = Workbooks("Archive.xls").Sheets(1)

If ActiveSheet.Range("$A$4").Value Like "01/01/****" Then
ActiveSheet.Rows("4:34").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:34").Delete
mnthlgth = 31 'Add April
ElseIf ActiveSheet.Range("$A$4").Value = #2/1/2008# Then
ActiveSheet.Rows("4:32").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:32").Delete
mnthlgth = 33 'Add May
ElseIf ActiveSheet.Range("$A$4").Value = #2/1/2012# Then
ActiveSheet.Rows("4:32").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:32").Delete
mnthlgth = 33 'Add May
ElseIf ActiveSheet.Range("$A$4").Value = #2/1/2016# Then
ActiveSheet.Rows("4:32").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:32").Delete
mnthlgth = 33 'Add May
ElseIf ActiveSheet.Range("$A$4").Value Like "01/02/****" Then
ActiveSheet.Rows("4:31").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:31").Delete
mnthlgth = 32 'Add May
ElseIf ActiveSheet.Range("$A$4").Value Like "01/03/****" Then
ActiveSheet.Rows("4:34").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:34").Delete
mnthlgth = 31 'Add June
ElseIf ActiveSheet.Range("$A$4").Value Like "01/04/****" Then
ActiveSheet.Rows("4:33").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:33").Delete
mnthlgth = 32 'Add July
ElseIf ActiveSheet.Range("$A$4").Value Like "01/05/****" Then
ActiveSheet.Rows("4:34").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:34").Delete
mnthlgth = 32 'Add August
ElseIf ActiveSheet.Range("$A$4").Value Like "01/06/****" Then
ActiveSheet.Rows("4:33").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:33").Delete
mnthlgth = 31 'Add September
ElseIf ActiveSheet.Range("$A$4").Value Like "01/07/****" Then
ActiveSheet.Rows("4:34").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:34").Delete
mnthlgth = 32 'Add October
ElseIf ActiveSheet.Range("$A$4").Value Like "01/08/****" Then
ActiveSheet.Rows("4:34").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:34").Delete
mnthlgth = 31 'Add November
ElseIf ActiveSheet.Range("$A$4").Value Like "01/09/****" Then
ActiveSheet.Rows("4:33").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:33").Delete
mnthlgth = 32 'Add December
ElseIf ActiveSheet.Range("$A$4").Value Like "01/10/****" Then
ActiveSheet.Rows("4:34").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:34").Delete
mnthlgth = 32 'Add January
ElseIf ActiveSheet.Range("$A$4").Value Like "01/11/****" Then
ActiveSheet.Rows("4:33").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:33").Delete
mnthlgth = 29 'Add February
ElseIf ActiveSheet.Range("$A$4").Value Like "01/12/****" Then
ActiveSheet.Rows("4:34").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:34").Delete
mnthlgth = 32 'Add March
End If

iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Cells(iLastRow, "A").AutoFill Cells(iLastRow, "A").Resize(mnthlgth)

End Sub

Thanks for your help.
Rob