Thanks Thanks:  0
Likes Likes:  0
Results 1 to 2 of 2

Thread: Variable copy and paste macro

  1. #1
    Board Regular
    Join Date
    Feb 2002
    Adelaide, Australia
    Post Thanks / Like
    0 Post(s)
    0 Thread(s)


    I need to copy and paste information from 1 workbook to another automatically, with varying amounts of data each week. The info is sorted in date order, and I will only want from-to a variable series of dates. ie this week I needed 1-Feb to 15-Feb, next week I may need 4-Feb to 11-Feb and so on.

    The ranges are all the same width (ie to column P) but the row numbers vary each week. I would like to be able to do it without knowing the number of rows. I am guessing that I will need a search function for the start and finish dates, but am not sure how to out this into practice.

  2. #2
    MrExcel MVP Tom Urtis's Avatar
    Join Date
    Feb 2002
    San Francisco, California USA
    Post Thanks / Like
    1 Post(s)
    1 Thread(s)


    Try this. It includes input boxes for you to enter the start and end dates. It will not matter whether your dates are sorted, or whether your destination workbook (called "Workbook2" in this example) is open or closed at the time the macro is run.

    Modify for Workbook2.xls file path, workbook names, sheet references, and ranges. You would place this macro in your source workbook (called "Workbook1" in this example).


    Sub TransferRecords()

    Dim Ldate As String
    Dim Udate As String
    Dim myRange As Range
    Set myRange = Range([A2], [P65536].End(xlUp))

    Ldate = InputBox("What is the Start / From date ?", "Enter the Starting From date.")
    If Ldate = "" Or Not IsDate(Ldate) Then
    MsgBox "Invalid date or nothing entered" & vbCrLf & "Click OK to cancel", 64, "Action cancelled"
    Exit Sub
    End If
    Udate = InputBox("What is the End / To date ?", "Enter the Ending To date.")
    If Udate = "" Or Not IsDate(Udate) Then
    MsgBox "Invalid date or nothing entered" & vbCrLf & "Click OK to cancel", 64, "Action cancelled"
    Exit Sub
    End If

    Application.ScreenUpdating = False

    With myRange
    .AutoFilter Field:=2, Criteria1:=">=" & Ldate, Operator:=xlAnd, _
    Criteria2:="<=" & Udate
    .Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
    End With

    On Error GoTo b:
    GoTo c:
    ChDir "C:YourFilePath"
    Workbooks.Open Filename:="C:YourFilePathWorkbook2.xls"
    [A65536].End(xlUp).Offset(1, 0).PasteSpecial (xlPasteAll)
    Application.CutCopyMode = False

    Sheet11.AutoFilterMode = False

    Application.ScreenUpdating = True

    End Sub


    Tom Urtis

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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