Issues copying the last few columns correctly.

[shauns]

I have written some code that copies data from one worksheet in a working workbook into a worksheet in an archive work book. The data is then organised by date, and any duplicates are removed from the archive before a year to dates worth of data is copied back from the archive workbook into the working workbook.

It seems to be working OK for the most part but I have noticed that the last 3 columns (AB, AC & AD) are not being copied from the working work book into the archive correctly, and are therefore not copying back the correct year to date data into the working workbook. All the other columns appear to be copied correctly but the last three columns are coming back jumble up and aren't correct.


I have tried altering the ranges but it doesn't seem to work. The data set is not continuous, so there are blank cells between rows and columns (i.e. not all the cells in the range contain data). I thought that determining the range would resolve this issue but it does not seemed to have worked.

As a quick work around I have hidden the last 3 columns, but it would be great to get this fixed. it would also be great to learn where I went wrong because I have just cannot see where the issue lies.


Any help is greatly appreciated.

Cheers


Here is the code I have used:

Sub OpenWorkbook()

'Open archive


  Workbooks.Open "\\sepa-fp-01\DIR SCIENCE\Hydrology\HYDROMETRY\SORT\Elgin\Elgin SORT Archive.xlsm"


'Find the last used row in both sheets and copy and paste data below existing data.

Dim wsCopy As Worksheet

Dim wsDest As Worksheet

Dim lCopyLastRow As Long

Dim lDestLastRow As Long

  'Set variables for copy and destination sheets

Set wsCopy = Workbooks("Elgin SORT.xlsm").Worksheets("Spreadsheet Archive")

Set wsDest = Workbooks("Elgin SORT Archive.xlsm").Worksheets("Spreadsheet Archive")


'1. Find last used row in the copy range based on data in column A

lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).row


'2. Find first blank row in the destination range based on data in column A

'Offset property moves down 1 row

  lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).row

'3. Copy & Paste Data

wsCopy.Range("A3:AD" & lCopyLastRow).Copy _

wsDest.Range("A" & lDestLastRow)


'Clear current archive


wsCopy.Range("A2:AD2" & lCopyLastRow).ClearContents



'Sort archive by date

    Windows("Elgin SORT Archive.xlsm").Activate

ActiveWorkbook.Worksheets("Spreadsheet Archive").AutoFilter.Sort.SortFields. _

Clear

ActiveWorkbook.Worksheets("Spreadsheet Archive").AutoFilter.Sort.SortFields. _

Add Key:=Range("C2:C49"), SortOn:=xlSortOnValues, Order:=xlDescending, _

DataOption:=xlSortNormal

With ActiveWorkbook.Worksheets("Spreadsheet Archive").AutoFilter.Sort

.Header = xlYes

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

ActiveWorkbook.Worksheets("Spreadsheet Archive").AutoFilter.Sort.SortFields. _

Clear

ActiveWorkbook.Worksheets("Spreadsheet Archive").AutoFilter.Sort.SortFields. _

Add Key:=Range("B2:B49"), SortOn:=xlSortOnValues, Order:=xlDescending, _

DataOption:=xlSortNormal

With ActiveWorkbook.Worksheets("Spreadsheet Archive").AutoFilter.Sort

.Header = xlYes

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply


Windows("Elgin SORT Archive.xlsm").Activate

ActiveWorkbook.Worksheets("Spreadsheet Archive").Select

ActiveSheet.Range("$A:$AD").RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes



Windows("Elgin SORT.xlsm").Activate


'Year to date filter


Windows("Elgin SORT Archive.xlsm").Activate

ActiveSheet.Range("$A$2:$AD$49").AutoFilter Field:=2, Criteria1:= _

xlFilterYearToDate, Operator:=xlFilterDynamic

Windows("Elgin SORT.xlsm").Activate



'Find the last used row in both sheets and copy and paste data below existing data.


'Set variables for copy and destination sheets

Set wsCopy = Workbooks("Elgin SORT Archive.xlsm").Worksheets("Spreadsheet Archive")

Set wsDest = Workbooks("Elgin SORT.xlsm").Worksheets("Spreadsheet Archive")


'1. Find last used row in the copy range based on data in column A

lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).row


'2. Find first blank row in the destination range based on data in column A

'Offset property moves down 1 row

  lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).row

'3. Copy & Paste Data

wsCopy.Range("A3:AD" & lCopyLastRow).Copy _

    wsDest.Range("A" & lDestLastRow)

'Remove year to date filter

Windows("Elgin SORT Archive.xlsm").Activate

ActiveSheet.Range("$A$2:$AD49").AutoFilter Field:=2

Windows("Elgin SORT.xlsm").Activate


'Save and Close Elgin Archive

Workbooks("Elgin SORT Archive.xlsm").Close SaveChanges:=True

End With


End Sub