cut to matching sheet problem

[Robert Hargreaves]

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

 

[Bob Phillips]

Hi Again Rob,

I am assuming the sheet with this name already exists?

Set wsArchive = Workbooks("Archive.xls").Sheets(Activesheet.Name)

Also, see my response to your earlier post. I see you have solve the
problem, but I suggested some changes for readability.

Again, when using wildcards, you only need one *, it applies to any number.
? applies to a single character.


--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Robert Hargreaves]

Thanks Bob you have been a big help,

I have made the changes. I would like to make the code usable in more than
one spreadsheet. I have added the code following you recommendations like
this:

Dim mnthlgth As Long
Dim iLastRow As Long
Dim wsArchive As Worksheet
Dim wsSource As Worksheet
Dim rngLAst As Range

Set wsSource = ThisWorkbook.Name
Set wsArchive = Workbooks("wssource & archive.xls").Sheets(ActiveSheet.Name)

I have tried to specify that the filename of the related archive workbook
should be wsSourcearchive.xls and will always be named this way.

This doesnt seem to have worked. I have tried activeworkbook.name and
thisworkbook.name

Can you tell me where I have got it wrong?

Thanks
Rob

 

[Robert Hargreaves]

I have used code like this to try to get around the problem

Path = ThisWorkbook.Path & "\"
Name = Mid(ThisWorkbook.Name, 1, Len(ThisWorkbook.Name) - 4)

Set wsArchive = Application.Workbooks(Path & Name &
"Archive.xls").Sheets(ActiveSheet.Name)
'also tried

'Set wsArchive = Workbooks(Path & Name &
"Archive.xls").Sheets(ActiveSheet.Name)

I am getting an error on the Set wsArchive Line.

I have tried the code like this to test the Path & Name variables and they
work to open the worksheet

Path = ThisWorkbook.Path & "\"
Name = Mid(ThisWorkbook.Name, 1, Len(ThisWorkbook.Name) - 4)

Application.Workbooks.Open (Path & Name & "Archive.xls")

This works and opens the relevant file why does it not write to it when
used in the different code?

Thanks
Rob

 

[Bob Phillips]

Hi Rob,

You don't seem to have quite got the concepts of objects yet .

There are a number of problems in these statements

Set wsSource = ThisWorkbook.Name
Set wsArchive = Workbooks("wssource & archive.xls").Sheets(ActiveSheet.Name)

This workbook is a workbook, so you cannot set a worksheet variable to it.
Then the .Name property returns a string, so you cannot set any object
variable to it, again you have simply assign it to a string variable.

Then in the wsArchive line, you seem to be trying to concatenate two
workbook names, ThisWorkbook.Name and archive.xls, but even then you have
wsoource in quotes, so you
won't get its value. If you are trying to get the path of thisworkbook and
archive.xls, then use

What exactly are you trying to achieve here as


Set wsArchive = Workbooks("archive.xls").Sheets(ActiveSheet.Name)

seems to be what you need, assuming that archive.xls is open.


--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Bob Phillips]

I think my previous reply still applies, so I'll wait until you answer that.

Regards

Bob

 

[Robert Hargreaves]

Thanks Bob,

I have made a few changes since I posted I have tried to use the code below
in a few different workbooks and set up a file naming rule so the code
doesnt need to be altered. Just the creator needs to follow a naming
convention. The name of the archive file (wsArchive will always be a
concatenation of the source workbook filename and the word archive.

Path = ThisWorkbook.Path & "\"
Name = Mid(ThisWorkbook.Name, 1, Len(ThisWorkbook.Name) - 4)

Set wsArchive = Application.Workbooks(Path & Name &
"Archive.xls").Sheets(ActiveSheet.Name)

EG the file is named-
rob.xls
the archivefile would be called robarchive.xls

Do you see now? Sorry for not explaining myself! The trouble is it still
doesnt work.

Rob

 

[Bob Phillips]

Rob,

You still seem to be trying to concatenate two different workbook names.

Can you give an example of the full name (path and filename) for a
ThisWorkbook, and then an example of the full name of the Archive workbook,
and we'll see if we can cut the code to suit?