Variable copy and paste macro

[svmac]

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.

 

[Tom Urtis]

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:
Windows("Workbook2.xls").Activate
GoTo c:
b:
ChDir "C:YourFilePath"
Workbooks.Open Filename:="C:YourFilePathWorkbook2.xls"
c:
Windows("Workbook2.xls").Activate
Sheets("Sheet1").Select
[A65536].End(xlUp).Offset(1, 0).PasteSpecial (xlPasteAll)
[A1].Select
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False

Windows("Workbook1.xls").Activate
Sheet11.AutoFilterMode = False

Application.ScreenUpdating = True

End Sub

''''''''''''''''''''''''''''''''''

Tom Urtis