The following code is now compiling but its copying over the headers from each spreadsheet, how i do amend this to copy from the next row down i.e. exclude the headers?
Thanks in advance
Code:
Sub Test()
SG_MoveColumns ("Starts")
SG_MoveColumns ("Leavers (incl SSMA Prog)")
SG_MoveColumns ("In-training")
SG_MoveColumns ("Achievements")
End Sub
Sub SG_MoveColumns(sSheetname As String)
Dim src As Worksheet 'NTP Performance Reports - Backup Data\2013-14\NTP Performance Report 2013-14 Period 6 September - Data.xlsx
Dim srcLastRow As Double
Dim srcLastCol As Double
Dim tgt As Worksheet 'Data in MAG Pivot Version Copy
Dim tgtLastRow As Double
Dim dest As Range
Dim i As Long
Dim x As Long
Dim sColLetter As String
Dim stgtColLetter As String
Dim bFoundCol As Boolean
' Switch screen updating back off
Application.ScreenUpdating = False
' Create objects to use
Set src = Worksheets(sSheetname) ' use sheet name passed in to the
srcLastRow = src.Cells(Rows.Count, 1).End(xlUp).Row
srcLastCol = src.Cells(1, Columns.Count).End(xlToLeft).Column
Set tgt = Workbooks("MAG Pivot Version Copy.xlsx").Worksheets("Data")
tgtLastRow = tgt.Cells(Rows.Count, 1).End(xlUp).Row
' Selects the columns to be copied
myColumns = Array("Status", "Assignment id", "Trainee district desc", "Gender", "Age Band", "VQ Level", "Updated programme", "Provider", "Updated Employer")
' Search the source worksheet to find the columns that the required field are in
For i = 0 To UBound(myColumns)
On Error Resume Next
' search the column headers - assume that held in row 1
' set the flag to NOT FOUND
bFoundCol = False
For x = 1 To srcLastCol
On Error Resume Next
If Trim(UCase(myColumns(i))) = Trim(UCase(src.Cells(1, x).Text)) Then
bfound = True
' convert the column number in to a column letter
sColLetter = Col_Letter(x)
' convert the array to the target column letter
stgtColLetter = Col_Letter(i + 1)
' copy of the column data
src.Range(sColLetter & "1:" & sColLetter & srcLastRow).Copy tgt.Range(stgtColLetter & tgtLastRow + 1)
Exit For
End If
Next x
Next i
'Tidy-up created objects
Set src = Nothing
Set tgt = Nothing
' Switch screen updating back on
Application.ScreenUpdating = True
End Sub
Function Col_Letter(lngCol As Long) As String
Dim vArr
' calculate the letter linked to the column
vArr = Split(Cells(1, lngCol).Address(True, False), "$")
' return the letter
Col_Letter = vArr(0)
End Function
Thanks in advance