Question

我在使用下面的代码时遇到问题，我想要的是用户在任何日期输入，然后当用户按下回车时，它会复制并粘贴有问题的所有行到工作表2？

我对VBA很陌生，所以非常感谢任何帮助。

Sub test()

strName = InputBox(Prompt:="Enter the date.", _
Title:="ENTER DATE", Default:="dd:mm:yy")

Dim cell As Excel.Range
 RowCount = DataSheet.UsedRange.Rows.Count
 Set col = DataSheet.Range("B1:B" & RowCount)
 Dim SheetName As String
 Dim cellValues() As String

 For Each cell In col

 cellValues = cell.Value
 SheetName = cellValues(0)

 If SheetName = strName Then
 cell.EntireRow.Copy

'and then paste into worksheet2

 End If
 Next
 End Sub

以下是自动输入日期的工作表宏：

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Cells.Count > 1 Then Exit Sub

        If Not Intersect(Target, Range("A2:A100001")) Is Nothing Then

            With Target(1, 2)

                .Value = Date

                .EntireColumn.AutoFit

            End With

        End If

End Sub

Answer 1

假设DataSheet是您要查找日期的工作表的名称，并假设＆＃34; Sheet2＆＃34;是一个存在的工作表，您想要粘贴数据，然后下面的代码应该工作。顺便说一句，如果DataSheet是ActiveSheet，则无需在代码中引用它，因为VBA假定它是您要使用的工作表。如果Sheet2尚不存在，请在For循环之前添加行Worksheets.Add.Name = "Sheet2"。

Sub test()
    Dim LastRowinB, CurrentRow, NextBlankRow As Long
    Dim strName As String
    NextBlankRow = 1
    LastRowinB = Worksheets("DataSheet").Range("B1048576").End(xlUp).Row

    strName = InputBox(Prompt:="Enter the date.", _
    Title:="ENTER DATE", Default:="dd:mm:yy")

    For CurrentRow = 1 To LastRowinB
        If strName = Worksheets("DataSheet").Range("B" & CurrentRow) Then
            Worksheets("DataSheet").Range("B" & CurrentRow).EntireRow.Copy
            Worksheets("Sheet2").Range("A" & NextBlankRow).PasteSpecial xlPasteAll
            NextBlankRow = NextBlankRow + 1
        End If
    Next
End Sub

VBA：提示日期并将具有该日期的单元格复制到工作表2宏中

1 个答案: