我目前有一个宏将搜索excel电子表格,然后将结果放在不同的表格中。唯一的问题是它在传输结果时不会复制颜色格式。这是代码。我试过粘贴特殊但它不适用于所有结果。
Sub Searchcustomer()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = wb.Sheets("Search")
If ws.Range("B3").Value = "" And ws.Range("B4").Value = "" And ws.Range("B5").Value = "" And ws.Range("B6").Value = "" And ws.Range("B7").Value = "" And ws.Range("B8").Value = "" Then
MsgBox "Please Enter Data into Table"
Exit Sub
End If
Dim msheet As Worksheet
Dim ssheet As Worksheet
Dim stand As String
Dim number As String
Dim customer As String
Dim states As String
Dim find As String
Dim audit As String
Dim saudit As String
Dim est As String
Dim pub As String
Dim finalrow As Integer
Dim finalrow2 As Integer
Dim i As Integer
Set msheet = Sheet4
Set ssheet = Sheet5
number = ssheet.Range("B3").Value
customer = ssheet.Range("B4").Value
states = ssheet.Range("B5").Value
find = ssheet.Range("B6").Value
audit = ssheet.Range("B7").Value
saudit = ssheet.Range("B8").Value
msheet.Select
finalrow = msheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To finalrow
If IIf(stand <> "", msheet.Cells(i, 1) = number, True) And IIf(number <> "", msheet.Cells(i, 2) = number, True) And IIf(customer <> "", msheet.Cells(i, 3) = customer, True) And IIf(states <> "", Cells(i, 4) = states, True) And IIf(find <> "", Cells(i, 5) = find, True) And IIf(audit <> "", Cells(i, 6) = audit, True) And IIf(saudit <> "", Cells(i, 7) = saudit, True) And IIf(est <> "", msheet.Cells(i, 8) = number, True) And IIf(pub <> "", msheet.Cells(i, 9) = number, True) Then
msheet.Range(msheet.Cells(i, 1), msheet.Cells(i, 9)).Copy
ssheet.Range("A100").End(xlUp).Offset(1, 0).Resize(1, 9).Value = msheet.Range(msheet.Cells(i, 1), msheet.Cells(i, 9)).Value
End If
Next i
ssheet.Select
ssheet.Range("B3").Select
End Sub
如果您使用,请注意
ssheet.Range("A100").End(xlUp).Offset(1, 0).Resize(1, 9).Value = msheet.Range(msheet.Cells(i, 1), msheet.Cells(i, 9)).Value
它只传输值但没有格式化。
如果你使用.Copy
,你需要指定目的地。你没有,因此你的.Copy
线什么都不做。 *请参阅Mathieu的评论如下。
抛出.Value
线并用以下内容替换.Copy
线:
msheet.Range(msheet.Cells(i, 1), msheet.Cells(i, 9)).Copy Destination:=ssheet.Range("A100").End(xlUp).Offset(1, 0).Resize(1, 9)
请注意,行计数变量必须是Long
类型Excel的行数多于Integer
可以处理的行数!
Dim finalrow As Long
Dim finalrow2 As Long
Dim i As Long