Excel VBA 复制数据和格式到另一个工作表
要将工作表 '销售明细表' 中对应的格式复制到工作表 '销售记录管理',可以使用 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 方法将源范围的格式粘贴到目标范围。这样,当数据被复制到 '销售记录管理' 表中时,也会复制源范围的格式。
原文地址: https://www.cveoy.top/t/topic/bN0n 著作权归作者所有。请勿转载和采集!