使用日期范围

时间:2017-07-21 17:59:38

标签: vba

您好我有以下代码将数据从一个工作表复制到同一工作簿中的两个日期范围之间的另一个工作表,但现在我正在尝试将数据从一个工作簿复制到另一个工作簿修改代码但不能要做。

Sub DataBasedOnDate()

Application.ScreenUpdating = False

Dim StartDate, EndDate As Date
Dim MainWorksheet As Worksheet
Dim dtTodayDate As String

StartDate = Sheets("Macro").Range("D6").Value
EndDate = Sheets("Macro").Range("D7").Value

Set MainWorksheet = Worksheets("database1")

MainWorksheet.Activate

Range("F1").CurrentRegion.Sort _
      key1:=Range("F1"), order1:=xlAscending, _
       Header:=xlYes

Range("F1").CurrentRegion.AutoFilter Field:=6, Criteria1:= _
        ">=" & StartDate, Operator:=xlAnd, Criteria2:="<=" & EndDate

ActiveSheet.AutoFilter.Range.Copy

dtTodayDate = Format(Date, "mmm-dd-yyyy")
On Error GoTo MakeSheet
    Sheets(dtTodayDate).Activate
    Exit Sub
MakeSheet:
    Sheets.Add , Worksheets(Worksheets.Count)
    ActiveSheet.Name = dtTodayDate

ActiveSheet.Paste

Selection.Columns.AutoFit

Range("F1").Select

MainWorksheet.Activate

Selection.AutoFilter

Sheets("Macro").Activate

End Sub

1 个答案:

答案 0 :(得分:0)

Sub DataBasedOnDate()

Application.ScreenUpdating = False

Dim StartDate, EndDate As Date
Dim MainWorksheet As Worksheet
Dim dtTodayDate As String

StartDate = Sheets("Macro").Range("D6").Value
EndDate = Sheets("Macro").Range("D7").Value

Set MainWorksheet = Worksheets("database1")

MainWorksheet.Activate

Range("F1").CurrentRegion.Sort _
      key1:=Range("F1"), order1:=xlAscending, _
       Header:=xlYes

Range("F1").CurrentRegion.AutoFilter Field:=6, Criteria1:= _
        ">=" & StartDate, Operator:=xlAnd, Criteria2:="<=" & EndDate

ActiveSheet.AutoFilter.Range.Copy

dtTodayDate = Format(Date, "mmm-dd-yyyy")

     Dim wb As Workbook
    Set wb = Workbooks.Open("location.xlsm")

        ActiveSheet.Name = dtTodayDate
        wb.ActiveSheet.Paste 'You can also input range to paste
        Selection.Columns.AutoFit
        Range("F1").Select

如果要返回原始工作簿,请将其命名。您还可以使用工作簿(1).activate。对于这个例子,我将其命名为

dim wb2 as workbook
    set wb2= workbooks("name of first opened workbook.xlsm")
    wb2.MainWorksheet.Activate

    Selection.AutoFilter

    Sheets("Macro").Activate


End Sub