提取并复制Excel文件中的数据

Question

I'm extracting data froman excel file that is inside the parameter of the dates provided. But this code is not working. Anybody can help me figure this out?

 Set src = wb.Sheets("Request Log Extract")
Set dest = ThisWorkbook.Sheets("Resolution Time Performance")

srcRow = src.Cells(src.Rows.Count, "K").End(xlUp).Row
destRow = dest.Cells(dest.Rows.Count, "E").End(xlUp).Row + 1
wb.Activate

For i = 2 To srcRow
    If src.Cells("K" & i) >= txtStartDate.Value Or src.Cells("K" & i) <= .txtEndDate.Value Then
        src.Cells("K" & i).Copy
        dest.Activate
        dest.Cells("E" & i).Paste
        src.Activate
    End If

Next

This returns an error saying :

Invalid procedure call or argument.

NOTE

txtStartDate and txtEndDate are date Types.

If I use OR in the If condition, all data were copied, but if I used And , no data is copied. I don't know whats going on.

VALUES

txtStartDate 05/13/2016 txtEndDate 05/18/2016 k2 05/14/2016

Answer 1

Im not sure with your txtStartDate and txtEndDate variables, but look at my code I declared your variables, but please specify date types, also i removed dot from txtEndDate and changed cell references and now it works.

Sub extractData()
Dim src
Dim dest
Dim wb As Workbook
Set wb = ThisWorkbook

Dim txtStartDate
Dim txtEndDate

Set src = wb.Sheets("Request Log Extract")
Set dest = ThisWorkbook.Sheets("Resolution Time Performance")

srcRow = src.Cells(src.Rows.Count, "K").End(xlUp).Row
destRow = dest.Cells(dest.Rows.Count, "E").End(xlUp).Row + 1

txtStartDate = 0
txtEndDate = 100

For i = 2 To srcRow
    If src.Cells(i, "K").Value > txtStartDate Or src.Cells(i, "K").Value < txtEndDate Then
        src.Cells(i, "K").Copy
        dest.Activate
        dest.Cells(i, "E").PasteSpecial
        src.Activate
    End If

Next

End Sub

Answer 2

I think it's a date value issue

Moreover I'm guessing your code is within some userform pane and activated at some button click after which it has to compare two textboxes values to some cells content and copy/paste values accordingly

should my guessing be right (finger crossed...) try this:

Option Explicit

Private Sub CommandButton1_Click()
    Dim src As Worksheet, dest As Worksheet
    Dim srcRow As Long, destRow As Long, i As Long
    Dim startDate As Date, endDate As Date, cellDate As Date

    With Me
        If Not ValidateDate("txtStartDate", .txtStartDate.Value, startDate) Then Exit Sub
        If Not ValidateDate("txtEndDate", .txtEndDate.Value, endDate) Then Exit Sub

        Set src = ActiveWorkbook.Sheets("Request Log Extract") '<~~ change workbook reference as per your need
        Set dest = ThisWorkbook.Sheets("Resolution Time Performance")
        srcRow = src.Cells(src.Rows.Count, "K").End(xlUp).Row
        destRow = dest.Cells(dest.Rows.Count, "E").End(xlUp).Row + 1

        For i = 2 To srcRow
            If ValidateDate("src.Range(""K" & i & """)", src.Range("K" & i), cellDate) Then
                If cellDate >= startDate And cellDate <= endDate Then src.Range("K" & i).Copy dest.Range("E" & i)
            End If
        Next
    End With
End Sub


Function ValidateDate(textName As String, textValue As String, retDate As Date) As Boolean
    ValidateDate = IsDate(textValue)
    If ValidateDate Then
        retDate = DateValue(textValue)
    Else
        MsgBox textValue & " is not a valid date" & vbCrLf & "please input a new value for " & textName
    End If
End Function

should my guessing be wrong, still the code above can give you some suggestions as to the date value issue

Answer 3

This code is working for me:

Sub Demo()
    Dim wb As Workbook
    Dim txtStartDate As Date, txtEndDate As Date

    Set wb = ActiveWorkbook
    Set src = wb.Sheets("Request Log Extract")
    Set dest = wb.Sheets("Resolution Time Performance")

    srcRow = src.Cells(src.Rows.Count, "K").End(xlUp).Row
    destRow = dest.Cells(dest.Rows.Count, "E").End(xlUp).Row + 1

    txtStartDate = "05/13/2016"
    txtEndDate = "05/18/2016"

    For i = 2 To srcRow
        If src.Range("K" & i).Value >= txtStartDate And src.Range("K" & i).Value <= txtEndDate Then
            src.Range("K" & i).Copy Destination:=dest.Range("E" & i)
        End If
    Next
End Sub