要将工作表 '销售明细表' 中对应的格式复制到工作表 '销售记录管理',可以使用 Range.Copy 方法将源范围的格式复制到目标范围。

以下是修改后的代码,将销售明细表的数据和格式复制到销售记录管理表:

Private Sub CommandButton2_Click()
    On Error Resume Next
    With Sheets('销售明细表')
        r = .Cells(.Cells.Rows.Count, "B").End(3).Row
        arr = .Range("B10:U" & r)
        .Range("B10:U" & r).Copy ' 复制数据和格式
    End With

    Dim str1 As String, str2 As String, str3 As String, str4 As String, str5 As String, str6 As String, str7 As String, str8 As String, str9 As String, str10 As String
    With Me
        str1 = .TextBox7.Value '窗体查询条件赋值给str1
        str2 = .TextBox8.Value
        str3 = .TextBox9.Value
        str4 = .TextBox10.Value
        str5 = .TextBox11.Value
        str6 = .TextBox12.Value
        str7 = .TextBox13.Value
        str8 = .TextBox14.Value
        str9 = .TextBox15.Value
        str10 = .TextBox16.Value
    End With

    If str1 = "" And str2 = "" And str3 = "" And str4 = "" And str5 = "" And str6 = "" And str7 = "" And str8 = "" And str9 = "" And str10 = "" Then
        MsgBox "请输入至少一个查询条件,以方便系统为您查询相应数据!", vbInformation, "系统提示"
        Exit Sub
    End If

    ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2) + 1)
    For i = 1 To UBound(arr)
        If (str1 = "" Or (arr(i, 1) Like "*" & str1 & "*" And str1 <> "")) _
        And (str2 = "" Or (arr(i, 2) Like "*" & str2 & "*" And str2 <> "")) _
        And (str3 = "" Or (arr(i, 3) Like "*" & str3 & "*" And str3 <> "")) _
        And (str4 = "" Or (arr(i, 4) Like "*" & str4 & "*" And str4 <> "")) _
        And (str5 = "" Or (arr(i, 5) Like "*" & str5 & "*" And str5 <> "")) _
        And (str6 = "" Or (arr(i, 9) Like "*" & str6 & "*" And str6 <> "")) _
        And (str7 = "" Or (arr(i, 10) Like "*" & str7 & "*" And str7 <> "")) _
        And (str8 = "" Or (arr(i, 13) Like "*" & str8 & "*" And str8 <> "")) _
        And (str9 = "" Or (arr(i, 18) Like "*" & str9 & "*" And str9 <> "")) _
        And (str10 = "" Or (arr(i, 19) Like "*" & str10 & "*" And str10 <> "")) _
        Then
            m = m + 1
            For j = 1 To UBound(arr, 2)
                brr(m, 1) = m
                brr(m, j + 1) = arr(i, j)
            Next
        End If
    Next
    
    With Sheets('销售记录管理')
        If m > 0 Then
            .Range("A10:U1048576").ClearContents
            .Range("A10").Resize(UBound(brr), UBound(brr, 2)).Value = brr ' 将数据填充到目标范围
            .Range("A10").Resize(UBound(brr), UBound(brr, 2)).PasteSpecial Paste:=xlPasteFormats ' 粘贴源范围的格式
            MsgBox "数据查询完毕", vbInformation, "系统提示"
        Else
            .Range("A10:U1048576").ClearContents
            MsgBox "抱歉,没有符合条件的数据,请您再次查证所录入的查询条件是否存在!", vbInformation, "系统提示"
        End If
    End With
End Sub

在修改后的代码中,我添加了以下代码:

.Range("A10").Resize(UBound(brr), UBound(brr, 2)).PasteSpecial Paste:=xlPasteFormats

该行代码使用 PasteSpecial 方法将源范围的格式粘贴到目标范围。这样,当数据被复制到 '销售记录管理' 表中时,也会复制源范围的格式。

Excel VBA 复制数据和格式到另一个工作表

原文地址: https://www.cveoy.top/t/topic/bN0n 著作权归作者所有。请勿转载和采集!

免费AI点我,无需注册和登录