将基于变量的单元格范围复制到另一个范围

Question

您好，从我的代码中可以很明显地看出我现在在做什么。 我正在尝试将一系列单元格从工作表的静态部分复制到创建的列中，但是我在公式的某些部分上一直遇到错误，希望这里有人对错误有解决方案，或者一种更好的方法，可以取一个范围可以是静态的单元格，并给基准点加一个硬点

Sub Mapping()

Dim Map As Worksheet
Dim Ath As Worksheet
Dim lastmap As Long
Dim lastath As Long
Set Ath = Sheets("Athena Greek God")
Set Map = Sheets("Mapping")
lastmap = Map.Cells(Rows.Count, "D").End(xlUp).Row
lastath = Ath.Cells(Rows.Count, "A").End(xlUp).Row



Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Range("A1") = "EDITED"
Range("B1") = "EDITED 2"
Range("C1") = "EDITED 3"
Range("D1") = "EDITED 4"
Columns("A:D").AutoFit
Range("A1:D" & lastath).Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.149998474074526
    .PatternTintAndShade = 0
End With

Clastath = Ath.Cells(1, Columns.Count).End(xlToLeft).Column

For x = Clastath To 1 Step -1
If ath.Cells(1, x) = "The Principals Book" Then
    ath.Range("D2: D" & lastath) = ath.Range(ath.Cells(2, x), ath.Cells(lastath, x))
End If
Next
End Sub

发生错误：

ath.Range("D2: D" & lastath) = ath.Range(ath.Cells(2, x), ath.Cells(lastath, x))

Answer 1

您应该使用.Value或.Value2在以下范围之间传输数据 ：

Ath.Range("D2: D" & LastAth).Value2 = Ath.Range(Ath.Cells(2, x), Ath.Cells(LastAth, x)).Value2

两者之间的主要区别是：

1. .Value2为您提供单元格的基础值（未格式化的数据）
2. .Value为您提供单元格的格式化值

有关更多详细信息，请在此处查看Charles William的博客。

---

正如您似乎在处理两张纸一样 （如果您没有Ath. ， 请不要在给出的代码中“映射”一张纸上 。如果不只是将Ath.更改为需要的Map. ）， 请不要忘记使用您创建的引用 （我加了他们无处不在，甚至在Rows.Count和Columns.Count如果你打开一个新的Excel版本的旧文件，以避免错误）

我摆脱了Select并在可能的地方缩短了代码，但是我猜想您稍后将在代码中使用“映射”表。

另外，当以后不再使用它时，也不要忘记释放这样的变量：

Set Ath = Nothing
Set Map = Nothing

---

---

这是您的代码已更正，清除和测试的代码 ：

Sub Mapping()

Dim Map As Worksheet, _
    Ath As Worksheet, _
    LastAth As Long, _
    LastMap As Long, _
    CLastAth As Long, _
    x As Integer


Set Ath = Sheets("Athena Greek God")
Set Map = Sheets("Mapping")
LastMap = Map.Cells(Map.Rows.Count, "D").End(xlUp).Row
LastAth = Ath.Cells(Ath.Rows.Count, "A").End(xlUp).Row

Ath.Columns("A:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Ath.Range("A1:D1").Value = Array("EDITED", "EDITED 2", "EDITED 3", "EDITED 4")
Ath.Columns("A:D").AutoFit

With Ath.Range("A1:D" & LastAth).Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.149998474074526
    .PatternTintAndShade = 0
End With


CLastAth = Ath.Cells(1, Ath.Columns.Count).End(xlToLeft).Column

For x = CLastAth To 1 Step -1
    If Ath.Cells(1, x) <> "The Principals Book" Then
    Else
        Ath.Range("D2: D" & LastAth).Value = Ath.Range(Ath.Cells(2, x), Ath.Cells(LastAth, x)).Value
    End If
Next x

Set Ath = Nothing
Set Map = Nothing

End Sub

Answer 2

取出空格：

我也将您的代码切碎，变暗X，并为您删除了选择项：

Sub Mapping()

Dim Map As Worksheet, Ath As Worksheet, lastmap As Long, lastath As Long, X As Long, Clastath As Long
Set Ath = Sheets("Athena Greek God")
Set Map = Sheets("Mapping")
lastmap = Map.Cells(Rows.Count, "D").End(xlUp).Row
lastath = Ath.Cells(Rows.Count, "A").End(xlUp).Row

Columns("A:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1:D1") = Array("EDITED", "EDITED 2", "EDITED 3", "EDITED 4")
Columns("A:D").AutoFit
With Range("A1:D" & lastath).Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.149998474074526
    .PatternTintAndShade = 0
End With

Clastath = Ath.Cells(1, Columns.Count).End(xlToLeft).Column

For X = Clastath To 1 Step -1
    If Cells(1, X) = "The Principals Book" Then
        Range("D2:D" & lastath) = Range(Cells(2, X), Cells(lastath, X))
    End If
Next
End Sub

编辑：Clastath也变暗了

Answer 3

实际上，并不清楚该代码应该实现什么，告诉您原因：定义了两个工作表，但只使用了其中一个，也不清楚将代码应用于哪个工作表。 就目前而言，该代码将应用于任何活动的工作表。

请参阅下面的代码进行调整和评论。 该代码假定该程序应适用于Ath工作表（根据需要进行更改）

尽管已解释了更改，但请让我知道您可能有任何疑问。

Option Explicit
Option Base 1

Sub Mapping()
Rem Worksheet "Map" is only used to obtain lastmap which is never used
Rem Therefore theese line are commented as they do not play any role in the procedure
'Dim Map As Worksheet
'Dim lastmap As Long
'Set Map = Sheets("Mapping")
'lastmap = Map.Cells(Rows.Count, "D").End(xlUp).Row ' NOT USED?

Rem Set array with titles - easy to maintain, and use to command all further intructions avoiding hard codding
Dim aTitles As Variant
aTitles = [{"EDITED","EDITED 2","EDITED 3","EDITED 4"}]

Dim Ath As Worksheet
Dim lastath As Long
Dim Clastath As Integer
Dim X As Integer

    Set Ath = Sheets("Athena Greek God")

    Rem It's not clear to which worksheet the code is to be applied?
    Rem Actually it is applied to whatever worksheet is active
    Rem This code assumes the procedure should be apply to the Ath worksheet
    With Ath '(change as needed)
        lastath = .Cells(Rows.Count, 1).End(xlUp).Row
        .Cells(1).Resize(, UBound(aTitles)).EntireColumn.Insert     'Using Titles array to insert required number of columns
        With Range(.Cells(1, 1), .Cells(lastath, UBound(aTitles)))  'Working with the range to be updated
            .Rows(1).Value = aTitles
            .Columns.AutoFit
            .Interior.Color = RGB(217, 217, 217)                    'Simplify method to set color

            Clastath = .Cells(1, Columns.Count).End(xlToLeft).Column

            Rem Use "Step -1" if you have more than one cell with value = "The Principals Book"
            Rem and you whant to catch the last occurrence. Otherwise no need to use it.
            Rem For X = Clastath To 1 Step -1 '(change if needed as per comment above)
            For X = 1 To Clastath
                If .Cells(1, X).Value = "The Principals Book" Then
                    Rem Old line, left only to show changes (.Value and .Value2)
                    Rem Ath.Range("D2: D" & lastath).Value = Ath.Range(Ath.Cells(2, X), Ath.Cells(lastath, X)).Value2
                    Ath.Range("D2: D" & lastath).Value = Ath.Range(Ath.Cells(2, X), Ath.Cells(lastath, X)).Value2
                    .Columns(4).Value = .Columns(1).Offset(0, X - 1).Value2
                    Exit For    'Exit For...Next after achieving its goal

    End If: Next: End With: End With

    Ath.Activate 'Only used to show\move to the worksheet updated

End Sub

Answer 4

您的代码值得几个注释。 首先，您必须解决问题（请参阅第1点）。 另外，几点可以减少修改时出错的机会，并提高效率。

1. 使用其他方法复制Range 。
   您必须指定要复制的内容（数据，公式，数字格式等），以决定使用哪种方法。

   • 仅复制数据。

      Ath.Range("D2:D" & lastath).Value2 = Ath.Range(Ath.Cells(2, x), Ath.Cells(lastath, x)).Value2 

     要么

      Ath.Range(Ath.Cells(2, x), Ath.Cells(lastath, x)).Copy Ath.Range("D2:D" & lastath).PasteSpecial xlPasteValues 

   • 复制（部分或全部）数字格式。 看到这个 。

      Ath.Range("D2:D" & lastath).Value = Ath.Range(Ath.Cells(2, x), Ath.Cells(lastath, x)).Value 

     要么

      Ath.Range(Ath.Cells(2, x), Ath.Cells(lastath, x)).Copy Ath.Range("D2:D" & lastath).PasteSpecial xlPasteValuesAndNumberFormats 

   • 复制公式。

      Ath.Range(Ath.Cells(2, x), Ath.Cells(lastath, x)).Copy Ath.Range("D2:D" & lastath).PasteSpecial xlPasteFormulas ' or xlPasteFormulasAndNumberFormats 

   • 全部复制。

      Ath.Range(Ath.Cells(2, x), Ath.Cells(lastath, x)).Copy Ath.Range("D2:D" & lastath).PasteSpecial xlPasteAll 

     要么

      Ath.Range(Ath.Cells(2, x), Ath.Cells(lastath, x)).Copy Destination:=Ath.Range("D2:D" & lastath) 

2. 完全限定您的Range 。
   这个问题一次又一次地出现（例如this ）。
   这是什么意思？ 不要使用Cells ， Range ， Rows或Columns而不指定它们属于哪个Worksheet ，除非您特别想要这样做（即使在那种情况下，显式使用ActiveSheet可以提高可读性并减少出错的可能性，类似于使用Option Explicit ） 。 例如，

    lastath = Ath.Cells(Rows.Count, "A").End(xlUp).Row 

   将从ActiveSheet获取Rows.Count ，它可能不是Ath 。 您可能不希望那样。 正确的形式是

    lastath = Ath.Cells(Ath.Rows.Count, "A").End(xlUp).Row 

   修正所有其他代码。 注意 ：在这种情况下，代码将继续执行，并且错误可能会被忽略，因为它会产生有效的结果。 在其他情况下，没有完全限定的Range的代码将引发错误（例如，带有sheet1.Range(Cells(... ，当sheet1不是ActiveSheet ）。

3. 您的代码似乎效率低下 。
   您可能多次将数据复制到同一Range 。 最好在第1行中找到最左侧的单元格，其中包含"The Principals Book" ，并将该列的范围复制到Range("D2:D" & lastath) 。 采用

    Dim x As Long For x = 1 To Clastath If Ath.Cells(1, x) = "The Principals Book" Then Ath.Range("D2:D" & lastath).Value2 = Ath.Range(Ath.Cells(2, x), Ath.Cells(lastath, x)).Value2 ' or alternatives above Exit For End If Next 

4. 目前尚不清楚要在哪个Worksheet表中插入列 。
   好像是Ath 。 不使用其他Worksheet 。

5. 您可以一次插入许多列。 您也可以一次将数据输入一个范围 。

    Ath.Columns("A:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Ath.Range("A1:D1").Value = Array("EDITED", "EDITED 2", "EDITED 3", "EDITED 4") 

Answer 5

1.删​​除字符串地址中的空格：之前：

ath.Range("D2: D" & lastath))

后：

ath.Range("D2:D" & lastath))

2a。 如果只想复制值，则在范围引用的末尾使用.value：在之前：

ath.Range("D2:D" & lastath).value = ath.Range(ath.Cells(2, x), ath.Cells(lastath, x)) 

后：

ath.Range("D2:D" & lastath).value = ath.Range(ath.Cells(2, x).value, ath.Cells(lastath, x).value).value

2b。 如果需要值和格式，请使用.copy（目标）：在之前：

ath.Range("D2:D" & lastath).value = ath.Range(ath.Cells(2, x), ath.Cells(lastath, x)) 

后：

ath.Range("D2:D" & lastath).copy(ath.Range(ath.Cells(2, x).value, ath.Cells(lastath, x).value))

另外，您应始终参考引用范围的工作表（例如ws.range("A1").value ）。 如果这不只是一个肮脏的项目，您还可以考虑使用工作表的.codename而不是.name。