在你的代码中,粘贴格式的操作无法成功复制'销售明细表'中的格式到'销售记录管理',原因是在粘贴操作之前,剪贴板中没有保存'销售明细表'的格式。

为了解决这个问题,可以使用PasteSpecial方法的xlPasteAll参数来复制数据和格式。修改代码如下:

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:=xlPasteAll ' 粘贴数据和格式
            MsgBox "数据查询完毕", vbInformation, "系统提示"
        Else
            .Range("A10:U1048576").ClearContents
            MsgBox "抱歉,没有符合条件的数据,请您再次查证所录入的查询条件是否存在!", vbInformation, "系统提示"
        End If
    End With
End Sub

这样修改后的代码会将数据和格式一起复制到'销售记录管理'表。请注意,这里使用xlPasteAll参数而不是xlPasteFormats来粘贴数据和格式。

VBA代码无法复制Excel表格格式的解决方案

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

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