我有一个宏，旨在从 Workbook1-Sheet1 复制数据并将其粘贴到 Workbook2-Sheet1 中。它完美地利用了变量和 .Copy 函数，但仅适用于某些变量。由于我无法确定的原因，它跳过了其他变量，因为它们的写法都与有效的变量相同。
我基本上重新调整了前一张表中使用的所有代码的用途，执行完全相同的操作，但添加了新的范围，因为在此特定实例中有更多列。我应该注意到，不幸的是，目标工作簿的目标列与源工作簿不同，因此我不能简单地选择整个工作簿并以这种方式复制/粘贴它。为了解决这个问题，我确定了源范围和目标范围，并将其应用于变量以供将来参考。
但是，复制/粘贴宏会在间歇点跳过变量，原因我不太清楚。这些变量都被正确命名，它们都指向正确的范围，并且代码对我来说没有出错。
为了清楚起见，我总共有 22 个变量； 11 个源范围变量和 11 个目标范围变量。该函数正确地复制/粘贴前 4 个和第 10 个变量，可靠地跳过 5-9 和第 11 个变量。有时，如果我第二次运行宏，它会正确复制/粘贴第五个和第六个变量，但仍然跳过其余的。宏的进一步重新运行将不会填充其余的列，并且一旦我启动目标工作簿的新实例，它就会继续跳过相同的变量。
下面是我正在使用的整个代码块，我将似乎无法运行的部分加粗：
Sub DataCopy()
'
'DataTemplate Macro
'Will copy/paste the data from the Data file into the appropriate columns.
'
'Keyboard Shortcut: Ctrl+e
'
On Error Resume Next 'Will ignore the error this will throw in the event that there aren't any empty rows.
Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'This will delete any rows upon finding blank cells; dangerous to use for most other sheets.
On Error GoTo 0 'Will close the "On Error Resume Next" call, and will allow errors for the rest of the codeblock.
'The above snippet is retained primarily in the event of an errant empty row being included.
Sheets(1).Select 'Selects the first sheet in numerical order.
Sheets(1).Name = "Sheet1" 'Renames the first sheet to "Sheet1".
' Range("A2").Select 'This will select the A2 Cell.
' Range(Selection, Selection.End(xlDown)).Select 'This then sets the selection range to extend to the last cell within A2 that houses data.
' Selection.TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
' TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
' Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
' :=Array(1, 3), TrailingMinusNumbers:=True 'This block sets different options on a date column from the "Text To Columns" Ribbon option.
' Selection.NumberFormat = "m/d/yyyy" 'Sets the cell range to format as Date instead of the numbers that the above block changes it to.
'We don't need the above code block because the dates are usually sent in the right format, but we're keeping it to implement later if necessary.
'
Dim Target As Worksheet 'Defines "Target" as a worksheet.
Dim rngm1, rngm2, rngm3, rngm4, rngm5, rngm6, rngm7, rngm8, rngm9, rngm10, rngm11 As Range 'Defines the "main" ranges as ranges.
Dim rngt1, rngt2, rngt3, rngt4, rngt5, rngt6, rngt7, rngt8, rngt9, rngt10, rngt11 As Range 'Defines the "target" ranges as ranges.
Dim lastrow As Object 'Defines "lastrow" as an Object explicitly.
Dim tsitea As Range
Dim tsiteb As Range
Dim i As Integer 'Setting this as an Integer assigns it to a 32bit limit, which is fine for what this variable is used for.
Dim m As Long 'Both m and k need to be "Long", which are larger bit limits -- this is necessary because the row sizes are much much higher.
Dim k As Long
'
'
'
Set Target = Workbooks("DataTarget.xls").Worksheets("Sheet1") 'This sets the "Target" variable to a specific workbook + identifies the sheets.
'
Set lastrow = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlNext).Rows
i = ActiveSheet.Range("A1").End(xlDown).Row
'MsgBox "This is the last row " & i 'This is to troubleshoot and to confirm the amount of rows within the sheet.
Set rngm1 = ActiveWorkbook.Worksheets("Sheet1").Range("A2", Range("A2").End(xlDown)) '"ActiveWorkbook" specifies the workbook you have open at the time of running.
Set rngm2 = ActiveWorkbook.Worksheets("Sheet1").Range("B2", Range("B2").End(xlDown)) 'This is true for the remainder of rngm1-11.
Set rngm3 = ActiveWorkbook.Worksheets("Sheet1").Range("C2", Range("C2").End(xlDown))
Set rngm4 = ActiveWorkbook.Worksheets("Sheet1").Range("D2", Range("D2").End(xlDown)) '.Range("x", Range("x").End(xlDown)) will select to when data ends in that column.
Set rngm5 = ActiveWorkbook.Worksheets("Sheet1").Range("E2", Range("E2").End(xlDown))
Set rngm6 = ActiveWorkbook.Worksheets("Sheet1").Range("F2", Range("F2").End(xlDown))
Set rngm7 = ActiveWorkbook.Worksheets("Sheet1").Range("G2", Range("G2").End(xlDown))
Set rngm8 = ActiveWorkbook.Worksheets("Sheet1").Range("H2", Range("H2").End(xlDown))
Set rngm9 = ActiveWorkbook.Worksheets("Sheet1").Range("I2", Range("I2").End(xlDown))
Set rngm10 = ActiveWorkbook.Worksheets("Sheet1").Range("J2", Range("J2").End(xlDown))
Set rngm11 = ActiveWorkbook.Worksheets("Sheet1").Range("K2", Range("K2").End(xlDown))
Set rngt1 = Target.Range("A2") 'Adding this before the offset variables below will make this macro work for blank books.
Set rngt2 = Target.Range("H2")
Set rngt3 = Target.Range("G2")
Set rngt4 = Target.Range("B2")
Set rngt5 = Target.Range("J2")
Set rngt6 = Target.Range("K2")
Set rngt7 = Target.Range("L2")
Set rngt8 = Target.Range("I2")
Set rngt9 = Target.Range("O2")
Set rngt10 = Target.Range("Q2")
Set rngt11 = Target.Range("N2")
On Error Resume Next
Set rngt1 = Target.Range("A2").End(xlDown).Offset(1, 0) '"Target" is already specified in the above variable, so all I have to do is define the range I want.
Set rngt2 = Target.Range("H2").End(xlDown).Offset(1, 0) 'As above, this continues further through rngt1-11.
Set rngt3 = Target.Range("G2").End(xlDown).Offset(1, 0)
Set rngt4 = Target.Range("B2").End(xlDown).Offset(1, 0) 'There is no need to declare the full range, only the target/destination cells and columns.
Set rngt5 = Target.Range("J2").End(xlDown).Offset(1, 0) 'Setting the range to the end of the column with a Row offset of 1 will paste the data directly beneath already existing data.
Set rngt6 = Target.Range("K2").End(xlDown).Offset(1, 0)
Set rngt7 = Target.Range("L2").End(xlDown).Offset(1, 0)
Set rngt8 = Target.Range("I2").End(xlDown).Offset(1, 0)
Set rngt9 = Target.Range("O2").End(xlDown).Offset(1, 0)
Set rngt10 = Target.Range("Q2").End(xlDown).Offset(1, 0)
Set rngt11 = Target.Range("N2").End(xlDown).Offset(1, 0)
On Error GoTo 0
rngm1.Copy rngt1 'Assigning the ".Copy" at the end of rngm% and then following it with rngt% can be read as:
rngm2.Copy rngt2 '"Copy from rngm% Paste to rngt%.
rngm3.Copy rngt3
rngm4.Copy rngt4
**rngm5.Copy rngt5** <--
**rngm6.Copy rngt6** <--
**rngm7.Copy rngt7** <--
**rngm8.Copy rngt8** <--
**rngm9.Copy rngt9** <--
rngm10.Copy rngt10
**rngm11.Copy rngt11** <--
k = Target.Range("B1").End(xlDown).Row 'This is getting the total amount of rows in the sheet.
MsgBox "The amount of rows in Target Sheet B are " & k 'These MsgBox lines are more for QA and to confirm the amount of rows.
m = Target.Range("E1").End(xlDown).Row '
MsgBox "The amount of rows in Target Sheet A are " & m 'If they slow the process down significantly, then they can be commented out.
If m < k Then 'This statement takes the row counts from above and runs the codeblock underneath if m is less than k.
Set tsitea = Target.Range("E" & m) 'This changes the source copy to be the final row found by m.
Set tsiteb = Target.Range("E" & m, "E" & k) 'Sets tsiteb to be from the last row found by m to the last row found by k.
tsitea.Copy tsiteb 'Copies tsitea to tsiteb under the parameters set above.
End If 'Closes the If statement.
Set Target = Nothing 'Setting all of these variables as Nothing is good practice to clear memory and resources up in larger functions.
Set lastrow = Nothing
Set rngm1 = Nothing
Set rngm2 = Nothing
Set rngm3 = Nothing
Set rngm4 = Nothing
Set rngm5 = Nothing
Set rngm6 = Nothing
Set rngm7 = Nothing
Set rngm8 = Nothing
Set rngm9 = Nothing
Set rngm10 = Nothing
Set rngm11 = Nothing
Set rngt1 = Nothing
Set rngt2 = Nothing
Set rngt3 = Nothing
Set rngt4 = Nothing
Set rngt5 = Nothing
Set rngt6 = Nothing
Set rngt7 = Nothing
Set rngt8 = Nothing
Set rngt9 = Nothing
Set rngt10 = Nothing
Set rngt11 = Nothing
Set tsitea = Nothing
Set tsiteb = Nothing
Application.CutCopyMode = False 'This clears the clipboard so as to prevent us from accidentally pasting a huge block of text elsewhere.
End Sub
如上所述，代码块中的其他所有内容似乎都有效，请将粗体/指向上面的部分保存起来。我找不到任何理由来解释为什么只有那些特定的变量无法正常运行，并且有一个变量会一直工作到最后。
我可以确认整个宏在一本空白书上起作用。我还可以确认，在已填充（且正确）的工作簿上，它不会简单地覆盖工作表顶部的数据。因此，我不确定问题是什么。
您确实不需要大部分变量。这是一种更紧凑的方法：
Sub DataCopy()
Dim wbSrc As Workbook, wsSrc As Worksheet, lrSrc As Long, lrTarget As Long
Dim wsTarget As Worksheet 'Defines "Target" as a worksheet.
Dim arrSrcCols, arrDestCols, col
Dim i As Long 'No real saving in using Integer...
Set wbSrc = ActiveWorkbook 'define which workbook is being copied from
Set wsSrc = wbSrc.Worksheets(1)
'in case any empty cells in Col A are included....
On Error Resume Next 'only really needed if ColA is completely filled
wsSrc.Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
Set wsTarget = Workbooks("DataTarget.xls").Worksheets("Sheet1")
'last row to copy and paste row should be the same for all columns...
lrSrc = LastOccupiedRow(wsSrc)
lrTarget = LastOccupiedRow(wsTarget)
'zero-based arrays of source + destination columns for each range being copied
arrSrcCols = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K")
arrDestCols = Array("A", "H", "G", "B", "J", "K", "L", "I", "O", "Q", "N")
For i = LBound(arrSrcCols) To UBound(arrSrcCols)
'range to copy
Set rng = wsSrc.Range(wsSrc.Cells(2, arrSrcCols(i)), _
wsSrc.Cells(lrSrc, arrSrcCols(i)))
'perform copy
rng.Copy Target.Cells(lrTarget + 1, arrDestCols(i))
Next i
'rest of your code here
End Sub
'return the last occupied row on a worksheet
Function LastOccupiedRow(ws As Worksheet) As Long
Dim f As Range
Set f = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not f Is Nothing Then LastOccupiedRow = f.Row
End Function