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