复制和粘贴VBA中存在格式问题的多个区域

Question

大家好：我用VBA写了一段代码。虽然它有效，但我在复制粘贴和格式化方面遇到了一些问题，我想让它更加优化。

我有3张纸："；Launchpad"Member_check"打印机">

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

**"Launchpad"的单元格值为G83**可以是3个选项之一：部分姐妹、完全姐妹、不对称姐妹。

我想做的是：如果用户在Launchpad上将单元格"G83"指定为"完整姐妹"：

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

我的问题是：

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

2. 某些范围的单元格具有不复制的公式#REF"；符号，除非我使用用值粘贴特殊，但是他们这样做会丢失他们的格式和字体。他们有办法用格式和字体复制值吗？

   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 = "YES" And Sheets("LAUNCHPAD").Cells(83, "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
   

Answer 1

请记住，您不需要选择任何内容。如果你提到Excel的单元格、工作表和工作簿的名称和地址，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(。在Excel365中有一个常量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,A78:J107,A112:H124"
Case "FULL SISTER"
Rng = "A7:J27,A78:J107,A127:H137"
Case Else
Rng = "A7:J74"
End Select
Worksheets("MEMBER_CHECK").Range(Rng).Copy Destination:=Worksheets("PRINTER").Range("A7")
Application.CutCopyMode = False