将基于variables的单元格范围复制到另一个Range
你好从我的代码应该是明显的，我在这一点上试图做。 我正在尝试从工作表的静态部分复制一个范围的单元格到一个创build的列，但我不断运行在公式的某个部分的错误我希望这里有人有一个解决scheme的错误，或一个更好的方法，采取一个范围的细胞，可以是静态的，并带来一个很难的参考点
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))
您应该使用.Value或.Value2来传输数据在这样的范围之间 ：
Ath.Range("D2: D" & LastAth).Value2 = Ath.Range(Ath.Cells(2, x), Ath.Cells(LastAth, x)).Value2
这两者的主要区别是：
-
.Value2给出了单元格的基础值（未格式化的数据） -
.Value为您提供单元格的格式化值
欲了解更多详情，请在这里查看Charles William的博客。
因为你似乎在两张纸上工作 （不是在你所提供的代码中的“映射”），如果我没有做到这一点， 不要忘记使用您创build的引用 （我将它们添加到任何地方，甚至在Columns.Count和Columns.Count之前，以避免在新的Excel版本上打开旧文档时出错）
我摆脱了Select并尽可能缩短代码，但我让“映射”表，我猜你会稍后在你的代码中使用它。
另外不要忘了释放你的abjectvariables像这样，当你以后不使用它时：
Set Ath = Nothing Set Map = Nothing
这是你的代码纠正，清理和testing ：
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
之后拿出空间：
我也砍了你的代码，Dimmed X，并删除了你的select：
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只要
实际上，这段代码应该实现的并不是很明显，告诉你为什么：定义了两个工作表，但是只有其中一个被使用，也不清楚要在哪个工作表上应用代码。 现在，代码被应用于任何工作表处于活动状态。
请参阅下面的代码，并进行调整和评论。 代码假定程序应该适用于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
你的代码值得几个意见。 首先，你必须解决你的问题（见第一点）。 另外，有几点可以减less修改错误的机会，提高效率。
-
使用其他方法复制
Ranges 。
您必须指定要复制的内容（数据，公式，数字格式等）以决定使用哪种方法。-
仅复制数据。
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)
-
-
完全符合您的
Range。
这个问题一再出现（例如， 这个 ）。
这是什么意思？ 不要使用Cells，Range，Rows或Columns而不指定它们属于哪个Worksheet，除非你特别想这样做（甚至在这种情况下，显式地使用ActiveSheet可以提高可读性并减less错误发生的机会，类似于使用Option Explicit） 。 例如，lastath = Ath.Cells(Rows.Count, "A").End(xlUp).Row将从
ActiveSheet，这可能不是Ath。 你可能不希望这样。 正确的forms是lastath = Ath.Cells(Ath.Rows.Count, "A").End(xlUp).Row修复所有其他代码。 注意 ：在这种情况下，代码继续执行，错误可能会被忽略，因为它会产生一个有效的结果。 在其他情况下，没有完全限定
Range的代码会抛出一个错误（例如，类似于sheet1.Range(Cells(...（当sheet1不是ActiveSheet））。 -
你的代码似乎效率低下 。
您可能将数据复制到相同的Range多次。 最好find第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 -
您不清楚在哪个
Worksheet表中插入列 。
它似乎是Ath。 另一个Worksheet不使用。 -
您可以一次插入许多列。 您也可以一次将数据input到一个范围内 。
Ath.Columns("A:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Ath.Range("A1:D1").Value = Array("EDITED", "EDITED 2", "EDITED 3", "EDITED 4")
1.删除string地址中的空格：Before：
ath.Range("D2: D" & lastath))
后：
ath.Range("D2:D" & lastath))
2A。 如果您只想复制值，则在范围引用的末尾使用.value：Before：
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。