在VBA中复制和粘贴具有格式问题的多个范围

如何解决在VBA中复制和粘贴具有格式问题的多个范围

大家好：我用VBA编写了一个代码。虽然可以，但是我在复制粘贴和格式设置方面遇到了一些问题，希望对其进行优化。

我有3张纸：“ Launchpad”，“ Member_check”，“打印机”

成员检查具有A到J列，每列300行

“ Launchpad”的单元格值为G83 **。 它可以是3个选项之一：半姐妹，全姐妹，不对称姐妹。

我想做的是： 如果，用户在启动板上将单元格“ G83”指定为“全姐妹”：

宏将复制一系列行A7：J27，A78：J107和A127：J137从检查器中，并粘贴到打印机。

我的问题是：

1. 如何使此代码一次处理多个范围，而不是重复复制和粘贴3次。

2. 某些单元格的范围内的公式不会复制并给出“ #REF”符号，除非我对值使用 paste special ，但是这样做会丢失其格式和字体。他们是否可以通过这种方法复制带有格式和字体的值？

    Sub PrintMembers()
   
    If Sheets("LAUNCHPAD").Cells(82,"G").Value = "NO" And Sheets("LAUNCHPAD").Cells(83,"G").Value = "" Then
    Sheets("MEMBER_CHECK").Range("A7:J74").Copy
    Sheets("PRINTER").Range("A7").PasteSpecial xlPasteFormats
    Sheets("PRINTER").Range("A7").PasteSpecial xlPasteValues
   
    ElseIf Sheets("LAUNCHPAD").Cells(83,"G").Value = "PARTIAL SISTER" Then
    Sheets("MEMBER_CHECK").Range("A7:J27").Copy
    Sheets("PRINTER").Range("A7").PasteSpecial xlPasteAllUsingSourceTheme
    Sheets("MEMBER_CHECK").Range("A78:J107").Copy
    Sheets("PRINTER").Range("A28").PasteSpecial xlPasteFormats
    Sheets("PRINTER").Range("A28").PasteSpecial xlPasteValuesAndNumberFormats
    Sheets("MEMBER_CHECK").Range("A112:H124").Copy
    Sheets("PRINTER").Range("A59").PasteSpecial xlPasteFormats
    Sheets("PRINTER").Range("A59").PasteSpecial xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
   
    ElseIf Sheets("LAUNCHPAD").Cells(82,"G").Value = "YES" And Sheets("LAUNCHPAD").Cells(83,"G").Value = "FULL SISTER" Then
    Sheets("MEMBER_CHECK").Range("A7:J27").Copy
    Sheets("PRINTER").Range("A7").PasteSpecial Paste:=xlPasteAllUsingSourceTheme
    Sheets("MEMBER_CHECK").Range("A78:J107").Copy
    Sheets("PRINTER").Range("A28").PasteSpecial Paste:=xlPasteFormats
    Sheets("PRINTER").Range("A28").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Sheets("MEMBER_CHECK").Range("A127:H137").Copy
    Sheets("PRINTER").Range("A59").PasteSpecial Paste:=xlPasteFormats
    Sheets("PRINTER").Range("A59").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
   
    ElseIf Sheets("LAUNCHPAD").Cells(82,"G").Value = "ASYMMETRIC FULL SISTER" Then
    Sheets("MEMBER_CHECK").Range("A141:J256").Copy
    Sheets("PRINTER").Range("A8").PasteSpecial xlPasteFormats
    Sheets("PRINTER").Range("A8").PasteSpecial xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
    End If
   
    End Sub
   

解决方法

请记住，您不需要选择任何内容。如果您通过名称和地址提到它们，Excel非常清楚其单元格，工作表和工作簿的位置。您代码中的最后一个ElseIf可以替换为下面的代码。

 Dim Rng As Range

 With Worksheets("MEMBER_CHECK")
    Set Rng = .Range("A7:J27,A78:J107,A127:H137")
 End With
 Rng.Copy Destination:=Worksheets("PRINTER").Range("A7")
 Application.CutCopyMode = False

这将在一个操作中复制3个范围，并避免PasteSpecial（xlPasteValues）留下格式。在Excel 365中，有一个常量xlPasteAll，我想也可以粘贴所有内容。

但是，循环For i = 80 To 80是多余的，您的代码真正要做的只是检查G82的值并评估结果。这为您提供了一个经典案例来演示Select语句。无论在单元格中找到什么，都会有一些东西要复制和粘贴。唯一的区别在于它将是什么。因此，我在下面建议替换您的整个代码。

Dim Rng As String

Select Case Worksheets("LAUNCHPAD").Cells(83,"G").Value
    Case "PARTIAL SISTER"
        Rng = "A7:J27,A112:H124"
    Case "FULL SISTER"
        Rng = "A7:J27,A127:H137"
    Case Else
        Rng = "A7:J74"
End Select

 Worksheets("MEMBER_CHECK").Range(Rng).Copy Destination:=Worksheets("PRINTER").Range("A7")
 Application.CutCopyMode = False