How do I amend the following code to work from the tgt workbook?

[Mr Denove]

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
    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, 2).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
                    'Range(sColLetter is the column reference & "2" is the row of that column i.e. 2 omits the header
                    src.Range(sColLetter & "2:" & 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

The above code currently works from the src workbook but this will change month on month and makes sense to move it to the tgt workbook.

Can someone please advise how I amend the code to to do this as its causing me problems?
Also need to find a way of adding the worksheets "Starts" etc to be copied over with the relevan data?
Thanks in advance

 

[Mr Denove]

Would that replace the Sub Test() code that is currently there and then the Sub SG_MoveColumns code after it still work?

 

[Andrew Poulsom]

It doesn't replace anything. It just demonstrates that there is no runtime error on the line:

Set src = Worksheets(sSheetname)

if the workbook that's opened contains a worksheet named Starts.

 

[Mr Denove]

ok if thats the case then I dont understand why you have provided that piece of code.

Can you please provide me with the fix or fixes that I need to make the code work properly?

 

[Andrew Poulsom]

If you are getting a subscript out of range error it's because the workbook doesn't contain a worksheet named Starts.

 

[Mr Denove]

As I mentioned earlier the file that appears in the ActiveWorkbook.Name is the Pivot file (ie the file the macro is stored and is also the file being copied to)

This should be the ....Period 1 April - Data file of which contains Starts, Leavers etc and is the source of the data being copied over.

In Summary the ActiveWorkbook.Name relates to the wrong file and this is what I am trying to rectify

 

[Andrew Poulsom]

The ActiveWorkbook is the workbook that was opened, unless you have activated a different workbook.

 

[Mr Denove]

As you can see from the code there are no other workbooks being opened at that time (as the Pivot file is already opened).

The error occurs as soon as I click 'Open' after selecting the relevant data file

 

[Andrew Poulsom]

What VBA code do you have now?

 

[Mr Denove]

Sub Test()
    Dim FName As Variant
    FName = Application.GetOpenFilename(FileFilter:="N:\SEEL\nsb 2\Reports - Monthly\NTP Performance Reports - Backup Data\2013-14(*.xlsx), *.xlsx", Title:="Select File To Be Opened")
    'If FName = False Then
        'Exit Sub
    Workbooks.Open FName
       'End If
    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 tgt As Worksheet
    Dim tgtLastRow As Double
    Dim tgtLastCol As Double
    Dim src As Worksheet     '
    Dim srcLastRow 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
    Dim Workbook As ThisWorkbook
      
    ' Switch screen updating back off
    Application.ScreenUpdating = False

    ' Create objects to use
      
    Set src = Workbooks(ActiveWorkbook.Name).Worksheets(sSheetname)
    'src = Workbooks(FName).Worksheets(sSheetname)  ' use sheet name passed in to the inputbox
    'srcLastRow = src.Cells(Rows.Count, 2).End(xlUp).Row
    srcLastRow = src.Cells(Rows.Count, 1).End(xlUp).Row
    srcLastCol = src.Cells(1, Columns.Count).End(xlToLeft).Column
      
    'ThisWorkbook.Worksheet("Data").Activate
    Set tgt = ThisWorkbook.Sheets("Data")
    'tgtLastRow = tgt.Cells(Rows.Count, 1).End(xlUp).Row
    'tgtLastCol = tgt.Cells(1, Columns.Count).End(xlToLeft).Column
    tgtLastRow = tgt.Cells(Rows.Count, 1).End(xlUp).Row
    
    
    ' Selects the columns to be copied
    myColumns = Array("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 tgtLastCol
            On Error Resume Next
            
                If Trim(UCase(myColumns(i))) = Trim(UCase(tgt.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
                    'Range(sColLetter is the column reference & "2" is the row of that column i.e. 2 omits the header
                    src.Range(sColLetter & "2:" & sColLetter & srcLastRow).Copy src.Range(ssrcColLetter & srcLastRow + 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

this is the current code which does select and open the file, but then does not continue into the SG_MoveColumns code instead fails on the same line yet again.
However, when I F8 through the code starting at SG_MoveColumns it does compile the code but due to a few changes by me isnt copying properly but I hope I can resolve that

 

[Mr Denove]

My Excel has just closed down....poor data connections in this office