I have a macro designed to copy data from Workbook1-Sheet1 and paste it into Workbook2-Sheet1. It utilizes variables and the .Copy function flawlessly, but only for some of the variables. It's skipping other variables for reasons I cannot identify as they're all written the same as the ones that work.
I've repurposed essentially all of the code I used for a previous sheet doing the exact same thing but adding new ranges as there's more columns in this particular instance. I should note that, unfortunately, the destination columns of the Target workbook are not the same as the Source workbook, and as such I cannot simply choose the entire workbook and copy/paste it that way. To tackle this issue, I've identified the source and target ranges and applied those to variables for future reference.
However, the copy/paste macro is skipping variables at intermittent points for reasons that I can't quite work out. The variables are all named appropriately, they're all pointing to the proper ranges, and the code isn't erroring out on me.
For clarity, I've got 22 total variables; 11 Source Range variables and 11 Target Range variables. The function properly copy/pastes the first 4 and the 10th variable, skipping 5-9 and the 11th reliably. Sometimes, if I run the macro a second time, it will properly copy/paste just the 5th and 6th variables but still skip the rest. No further re-runs of the macro will populate the rest of the columns, and as soon as I launch a new instance of the target workbook, it continues to skip the same variables.
Below is my entire code block that I'm using, and I'm bolding the parts that don't seem to run:
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
As stated, everything else within the codeblock seems to work, save the bolded/pointed to sections above. I cannot find any reason as to why only those specific variables would not run properly, and with one working towards the end.
I can confirm that the entire macro functions on a blank book. I can also confirm that on the already populated (and correct) workbook, it does not simply overwrite data at the top of the sheet. Due to this, I am unsure as to what the issue is.
You really don't need most of those variables. Here's a more compact approach:
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