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

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

我有3张：“启动板”、“会员支票”、“打印机”

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

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

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

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

我的问题是：

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

某些单元格区域的公式不会复制，并给出“#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

---

请记住，您不需要选择任何内容。如果您按名称和地址提及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个范围，并避免粘贴特殊（xlPasteValues），从而留下格式。在Excel 365中有一个常量xlPasteAll，我认为它也可以粘贴所有内容

但是，i=80到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

谢谢，这是最简单的。然而，我无法让它运行。我犯了两个错误。1.它应该是
End Select
，而不是
End if
2。复制操作不能在多个选择上运行是一个错误。再次感谢您的帮助。很抱歉输入错误。我纠正了语法。至于您遇到的错误，我无法在Excel 365上重现。你们有什么版本？你可能也没有全部。您可能需要使用PasteSpecial来粘贴选择。我记得需要多次调用PasteSpecial来复制值和格式。我担心第二次复制操作会重写第一次，但事实并非如此。我正在使用Office 365。在阅读了您的评论后，我刚刚重新启动了excel，代码现在正在运行。非常感谢。