VBA将相应的数据复制并粘贴到新工作表上

Question

I am trying to use VBA to ask the user to enter a date. For that date, copy all appointments and paste them on sheet “Daily Appts”, one-by-one. My reference sheet that contains all the data corresponding to given dates is named "Appts". I attached a picture for reference. Leading up to this, I created worksheet "Daily Sheet" and copy and pasted the headers from "Appts" onto it. I am trying to get every value for the date entered to copy and paste onto the new sheet but I am stuck. For example, if user enters 10/01/2018, it will have multiple sets of data that needs to be copied over. Here is what I have so far. Step 6 is where I need help to complete the task. 1 : https://i.stack.imgur.com/vEtUd.png

'Step 1:
Sub Part2()
Dim sheet As Variant
'Step 2: Add code to delete sheet "Daily Appts", if exist.
    For Each sheet In ActiveWorkbook.Worksheets
        If sheet.Name = "Daily Appts" Then
            Application.DisplayAlerts = False
            Worksheets("Daily Appts").Delete
            Application.DisplayAlerts = True
        End If
    Next sheet 
'Step 3: Add code to add a new sheet, name it "Daily Appts"
    Sheets("Main").Select
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Select
    ActiveSheet.Name = "Daily Appts"
    Sheets("main").Select
'Step 4: Add code to select the worksheet "Appts". Name the range that holds             
'the title (first row), the range that contains the data, and the range 
'contains the schedule.
Sheets("Appts").Select
Dim Title As Range, Data As Range, Schedule As Range
    Set Title = Range("A1", Range("A1").End(xlToRight))
    Title.Name = "Title"

    Set Data = Range("A2", Range("A2").End(xlDown).End(xlToRight))
    Data.Name = "Data"

    Set Schedule = Range("J2", Range("J2").End(xlDown))
    Schedule.Name = "Schedule"


'Step 5: Add code to copy and paste the title into the new sheet, "Daily         
'Appts".
    Sheets("Appts").Range("Title").Copy 'Copy the data
    Sheets("Daily Appts").Activate 'Activate the destination worksheet
    Range("A1").Select 'Select the target range
    ActiveSheet.Paste 'Paste in the target destination

    Application.CutCopyMode = False
'Step 6: Ask the user to enter a date.  For that date, copy all appointments     
'and paste them on sheet "Daily Appts", one-by-one.
Dim result As String, i As Long, mydate As Date
Sheets("Appts").Select
    result = InputBox("Enter a date")

    For i = 2 To 360
        mydate = Cells(i, 10)
        If mydate = result Then
        Sheets("Appts").Range("J2").End(xlToLeft).Copy
        Sheets("Daily Appts").Activate
        Range("A2").End(xlDown).Select
        ActiveSheet.Paste
        End If
    Next
End Sub

Answer 1

There is not reason to loop to test whether a single sheet exists a simple test if a cell reference is valid will do it:

If Not IsError(Application.Evaluate("'Daily Appts'!A1")) Then Worksheets("Daily Appts").Delete

Also by declaring a worksheet variable on the addition it make it easier to work with the sheet later:

Dim ws As Worksheet
Set ws = Worksheets.Add(After:=Worksheets("Main"))
ws.Name = "Daily Appts"

Then there is no need for the range.name as you created the ranges as variables just refer to them.

Then in the loop you need to iterate the copy ranges.

I also cleaned up the .Activate and .Select which should be avoided.

Sub Part2()

'Step 2: Add code to delete sheet "Daily Appts", if exist.
    If Not IsError(Application.Evaluate("'Daily Appts'!A1")) Then Worksheets("Daily Appts").Delete
'Step 3: Add code to add a new sheet, name it "Daily Appts"
    Dim ws As Worksheet
    Set ws = Worksheets.Add(After:=Worksheets("Main"))
    ws.Name = "Daily Appts"
'Step 4: Add code to select the worksheet "Appts". Name the range that holds
'the title (first row), the range that contains the data, and the range
'contains the schedule.

    With Worksheets("Appt")
        Dim lCol As Long
        lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

        Dim lRow As Long
        lRow = .Cells(.Rows.Count, 1).End(xlUp).Row

        Dim Title As Range
        Set Title = .Range(.Cells(1, 1), .Cells(1, lCol))

'Step 5: Add code to copy and paste the title into the new sheet, "Daily
'Appts".
        Title.Copy ws.Range("A1") 'Paste in the target destination

'Step 6: Ask the user to enter a date.  For that date, copy all appointments
'and paste them on sheet "Daily Appts", one-by-one.
        Do
            Dim result As String
            result = InputBox("Enter a date")
            If Not IsDate(result) Then MsgBox ("must be date")
        Loop Until IsDate(result)

        For i = 2 To lRow
            If .Cells(i, 10).Value2 = CDate(result) Then
                .Range(.Cells(i, 1), .Cells(i, lCol)).Copy ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(1)
            End If
        Next
    End With
End Sub