VBA 代码，将当前月份数据复制并粘贴到单元格为空白的另一张工作表中

Question

我基本上是尝试从一张纸中复制“当前月份”的数据，然后粘贴到单元格为空白的另一张纸中（将数据附加到已有的数据中）。有人可以帮忙吗？我对 VBA 还很陌生，因此我们将不胜感激。谢谢！

我还没有尝试编写代码，因为我对 VBA 还很陌生。

Answer 1

使用

AutoFilter

将本月数据复制到现有工作表

Sub CopyThisMonth()
    
    Const sSHEET As String = "Sheet1"
    Const sFIELD As Long = 2
    Dim sCRITERIA As XlDynamicFilterCriteria: sCRITERIA = xlFilterThisMonth
    Dim sOPERATOR As XlAutoFilterOperator: sOPERATOR = xlFilterDynamic
    Const dSHEET As String = "Sheet2"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim dcell As Range, WasDataCopied As Boolean
    
    With wb.Sheets(dSHEET).UsedRange
        Set dcell = .Columns(1).Cells(.Rows.Count).Offset(1)
    End With
    
    With wb.Sheets(sSHEET)
        .AutoFilterMode = False
        With .Range("A1").CurrentRegion
            .AutoFilter sFIELD, sCRITERIA, sOPERATOR ' filter
            If .Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
                .Resize(.Rows.Count - 1).Offset(1).Copy dcell ' copy
                WasDataCopied = True
            End If
        End With
        .AutoFilterMode = False
    End With

    If WasDataCopied Then
        MsgBox "This month's data copied.", vbInformation
    Else
        MsgBox "No this month's data found.", vbExclamation
    End If

End Sub