Question

已解决，请参阅以下代码

我正在编写一个过滤数据并将过滤后的数据粘贴到“目标”表的代码。在“评论”表中，有一个长列表，其中的数据可以细分为某些类别。在封面的单元格F9中，我可以选择一个类别。按下按钮后，需要过滤“评论”表中的数据，过滤后留下的数据应粘贴在“目标”表中。 “目的地”表格是一张空白的新表格。

过滤部分有效，但复制粘贴部分会出现一些错误。因为“评论”表中有一些合并的单元格。我能够粘贴格式和列宽，但由于合并的单元格，值会产生错误。有办法解决这个问题吗？

除此之外，在粘贴格式时，会在过滤前将其粘贴到与“审核”表中相同的行数。我希望格式化仅适用于过滤后留下的行数。

我希望有人可以帮助我。

请参阅下面的源代码：

Dim wksCVP As Worksheet
Dim wksReview As Worksheet
Dim wksNew As Worksheet

Set wksReview = Worksheets("REVIEW")
Set wksCVP = Worksheets("COVER PAGE")
Set wksNew = ThisWorkbook.Worksheets.Add

wksReview.Cells.Copy wksNew.Cells
wksNew.Cells.UnMerge

Dim LastRow As Long
With wksNew
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

Select Case wksCVP.Range("F9").Value
    Case "Instrumentation"
        kolom = "J"
    Case "Equipment"
        kolom = "K"
    Case "Design / Fabrication"
        kolom = "L"
    Case "Inspection & Testing"
        kolom = "M"
    Case "General / Other"
        kolom = "N"
End Select

If wksCVP.Range("F9").Value <> "" Then
    For i = 5 To LastRow
        If wksNew.Range(kolom & i).Value <> "X" Then
            wksNew.Rows(i).EntireRow.Hidden = True
        End If
    Next i
End If

 wksNew.Activate
ActiveSheet.Range("A5", "Z" & LastRow + 1).SpecialCells(xlCellTypeVisible).Copy

With Sheets("DESTINATION").Range("A1")
    .PasteSpecial Paste:=xlPasteAll
End With

wksNew.delete

Answer 1

对于仅在部分复制的合并单元格中的Formats和ColumnWidths，最简单的方法是添加新工作表，在那里复制初始值并取消合并。然后做这样的事情：

Option Explicit

Sub TestMe()

    Dim wksTheNew           As Worksheet
    Dim wksReview           As Worksheet
    Dim wksDestination      As Worksheet

    Set wksReview = Worksheets("Review")
    Set wksDestination = Worksheets("Destination")

    Set wksTheNew = ThisWorkbook.Worksheets.Add

    wksReview.Cells.Copy wksTheNew.Cells
    wksTheNew.Cells.UnMerge

    'now copy the formats and the values from wksTheNew
    'it will not give an error, because it is unmerged

    Application.DisplayAlerts = False
    wksTheNew.Delete
    Application.DisplayAlerts = True

End Sub

准备好您的操作后，您可以删除新的工作表。

Answer 2

只需更改序列：

With Sheets("DESTINATION").Range("A1")
    .PasteSpecial Paste:=xlPasteValues
    .PasteSpecial Paste:=xlPasteFormats
    .PasteSpecial Paste:=xlPasteColumnWidths
End With

先粘贴值不应该触发错误。

由于合并的单元格导致复制粘贴错误

2 个答案: