How do I amend this to use a destination sheet in a different workbook?

[Mr Denove]

Sub Test()  'Stewarts working code with all Columns named correctly and Source Sheets defined
    
    
    
    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 srcWorkbook As Workbook
    Dim srcLastRow As Double
    Dim srcLastCol As Double
    Dim tgt As Worksheet
    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 = Worksheets("SheetX")
    tgtLastRow = tgt.Cells(Rows.Count, 1).End(xlUp).Row

    ' Selects the columns to be copied
    myColumns = Array("Assignment id", "Programme", "Creditor", "Framework id", "MA framework desc", "Input Dat", "Start date", "VQ reference", "VQ title", "First names", "Last name", "NI number", "Date of birth", "Gender", "Trainee district desc", "Company town", "Company postcode in", "Company postcode out", "Learning Provider on Contract", "Updated Programme", "Age Band", "Updated Employer", "MA Framework Band", "STATUS")
    ' 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 & "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
    
    MsgBox "Complete All Columns"

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 is using SheetX in the workbook where the source worksheets are located.
How do I use another workbook/worksheet that is not the same as the source workbook/sheet?
Thanks, in advance

 

[Andrew Poulsom]

Did you try?

Set tgt = Workbooks("NameOfOtherWorkbook").Worksheets("SheetX")

changing NameOfOtherWorkbook to suit? The target workbook must be open of course.

 

[Mr Denove]

Hi Andrew,

Thanks for replying.

The full code runs, copies and now pastes into the destination file I am wanting. Thank you.
However, after I click OK on the MsgBox i get Runtime error 9 Subscript out of range.

Set src = Worksheets(sSheetname)

Would I be on the right track thinking it has looped too far and needs to be told when / where to stop?

 

[Andrew Poulsom]

If you don't qualify the Worksheets property with its Workbook, the ActiveWorkbook will be used. To use the Workbook that contains your VBA code:

Set src = ThisWorkbook.Worksheets(sSheetname)

 

[Mr Denove]

All sorted now Andrew and thanks for your help.

Just the minor issue of the MsgBox prompting 3 times

 

[Andrew Poulsom]

You can remove the MsgBox line if you don't want to see it.

 

[Mr Denove]

It will be getting used by other members of the team so its more a visual aid for them so would like to keep it if I can make it appear only once and / or finish on the destination file.

 

[Andrew Poulsom]

Move it here then:

Sub Test()  'Stewarts working code with all Columns named correctly and Source Sheets defined
    SG_MoveColumns ("Starts")
    SG_MoveColumns ("Leavers (incl SSMA Prog)")
    SG_MoveColumns ("In-training")
    SG_MoveColumns ("Achievements")
    MsgBox "Complete All Columns"
End Sub