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

编程问答 2022-08-15

问题描述

大家好：我用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
copy-pasteexcelexcelformatrange