+ Reply to Thread
Results 1 to 8 of 8

cut to matching sheet problem

  1. #1
    Robert Hargreaves
    Guest

    cut to matching sheet problem

    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




  2. #2
    Bob Phillips
    Guest

    Re: cut to matching sheet problem

    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" <robhargreaves@netbreeze.co.uk> wrote in message
    news:d7c5nj$tfl$1@newsg1.svr.pol.co.uk...
    > 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
    >
    >
    >




  3. #3
    Robert Hargreaves
    Guest

    Re: cut to matching sheet problem

    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

    "Bob Phillips" <bob.phillips@notheretiscali.co.uk> wrote in message
    news:uRDJ4XFZFHA.1412@TK2MSFTNGP12.phx.gbl...
    > 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" <robhargreaves@netbreeze.co.uk> wrote in message
    > news:d7c5nj$tfl$1@newsg1.svr.pol.co.uk...
    >> 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
    >>
    >>
    >>

    >
    >
    >





  4. #4
    Robert Hargreaves
    Guest

    Re: cut to matching sheet problem

    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




  5. #5
    Bob Phillips
    Guest

    Re: cut to matching sheet problem

    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)


    "Robert Hargreaves" <robhargreaves@netbreeze.co.uk> wrote in message
    news:d7cl6r$36e$1@newsg4.svr.pol.co.uk...
    > 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
    >
    > "Bob Phillips" <bob.phillips@notheretiscali.co.uk> wrote in message
    > news:uRDJ4XFZFHA.1412@TK2MSFTNGP12.phx.gbl...
    > > 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" <robhargreaves@netbreeze.co.uk> wrote in message
    > > news:d7c5nj$tfl$1@newsg1.svr.pol.co.uk...
    > >> 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
    > >>
    > >>
    > >>

    > >
    > >
    > >

    >
    >
    >




  6. #6
    Bob Phillips
    Guest

    Re: cut to matching sheet problem

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

    Regards

    Bob

    "Robert Hargreaves" <robhargreaves@netbreeze.co.uk> wrote in message
    news:d7cq55$6kt$1@newsg2.svr.pol.co.uk...
    > 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
    >
    >
    >




  7. #7
    Robert Hargreaves
    Guest

    Re: cut to matching sheet problem

    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




  8. #8
    Bob Phillips
    Guest

    Re: cut to matching sheet problem

    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?

    --
    HTH

    Bob Phillips

    "Robert Hargreaves" <robhargreaves@netbreeze.co.uk> wrote in message
    news:d7cvii$b32$1@newsg2.svr.pol.co.uk...
    > 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
    >
    >
    >




+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1