Question

我有一个VBA脚本，用于过滤L列中的日期，其中月份应该在当前下个月之前，以及在第二张图片中显示的AH或AI列中的月份之后。过滤掉我的VBA脚本之间的正确月份后，应将整行数据复制到下一个工作表，填写从下面发布的第二张图片中复制的主机名。但是我的代码没有过滤出L列的任何数据，它最终会复制所有内容。

我的代码在这里：

Sub Paste_Dates()

Dim wSheet1 As Worksheet
Dim wSheet2 As Worksheet
Dim wSheet3 As Worksheet
Dim wkbSourceBook As Workbook
Dim wkbCrntWorkBook As Workbook
Dim worksheetName As String
Default As String
Dim wSlastRow As Integer
Dim wSLastPasteRow As Integer 'This will be used to check how far down has been copied thus far
Dim X As Integer
Dim NumberOfPasteRows As Integer 'This will store how many months there are between dates, to paste into
Dim PasteCounter As Integer

Set wkbCrntWorkBook = ActiveWorkbook
'// Set here Workbook(Sheets) names
Set wSheet2 = wkbCrntWorkBook.ActiveSheet
Set wSheet3 = wkbCrntWorkBook.Worksheets("Sheet1")
wSLastPasteRow = 2
'extract data from another excel file
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xls"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then

    'Prompts user to choose which Worksheet they want to copy from
    MSG1 = MsgBox("Do you wish to copy from 'Overall details' ?", vbYesNo, "Name of Worksheet")
    If MSG1 = vbYes Then
        worksheetName = "Overall details"
    Else
        Default = "Sheet"
        worksheetName = Application.InputBox("Enter the name of Worksheet (Case-sensitive)", Default, Default)
    'End of first If statement
    End If

    Set wkbSourceBook = Workbooks.Open(.SelectedItems(1))
    Set wSheet1 = wkbSourceBook.Sheets(worksheetName)

    With wSheet1

    '// Here lets Find the last row of data
    wSlastRow = .Rows(.Range("B:B").Rows.Count).End(xlUp).Row

    '// Now Loop through each row
        For X = 2 To wSlastRow

        If Not IsError(.Range("AJ" & X).Value) Then
            If IsDate(.Range("AJ" & X)) Then


            dtStart = DateSerial(Year(.Range("AJ" & X)), Month(.Range("AJ" & X)) + 1, 1)
            dtFinal = DateSerial(Year(Now), Month(Now) + 1, 1)

            wSheet3.Range("L:L").AutoFilter 1, ">=" & dtStart, xlAnd, "<" & dtFinal 
            NumberOfPasteRows = wSheet3.Rows(.Range("A:A").Rows.Count).End(xlUp).Row
            'NumberOfPasteRows = DateDiff("m", .Range("AJ" & X), "08/2015")
            'This finds the difference between your two dates in rounded months, and pastes for that number of rows
            'NOTE: A1 SHOULD BE REPLACED WITH WHATEVER DEFINES THE "JUNE 2015 COMPARISON"

                For PasteCounter = 1 To NumberOfPasteRows

                    wSheet3.Range("A" & X).EntireRow.Copy Destination:=wSheet2.Range("A" & wSLastPasteRow)
                    .Range("B" & X).Copy Destination:=wSheet2.Range("B" & wSLastPasteRow) 

                    wSLastPasteRow = wSLastPasteRow + 1
                Next PasteCounter
            End If
        End If
        If (wSheet3.AutoFilterMode And wSheet3.FilterMode) Or wSheet3.FilterMode Then
          wSheet3.ShowAllData
        End If
        Next X

    End With
    wkbSourceBook.Close False
End If
End With

'Free objects
Set wkbCrntWorkBook = Nothing
Set wSheet2 = Nothing
Set wkbSourceBook = Nothing
Set wSheet1 = Nothing

'// Simple Msg Box
MsgBox "Copy & Paste is Done."
End Sub

无法按VBA中的特定月份过滤掉数据

0 个答案: