Copy data from one workbook to new workbook in excel VB

Question

I want to copy selected columns of a file from a worksheet to a new workbook using VBS in Excel. The following code gives the empty columns in new file.

 Option Explicit
 'Function to check if worksheets entered in input boxes exist
 Public Function wsExists(ByVal WorksheetName As String) As Boolean

    On Error Resume Next
    wsExists = (Sheets(WorksheetName).Name <> "")
    On Error GoTo 0 ' now it will error on further errors

 End Function

 Sub createEndUserWB()

    Dim i As Integer
    Dim colFound As String
    Dim b(1 To 1) As Integer
    Dim Sheet_Copy_From As String
    Dim newSheet As String
    Dim colVal As Variant 'sheet name from array to test
    Dim colNames As Variant 'Array
    Dim col As Variant
    Dim colN As Integer
    Dim lkr As Range
    Dim destWS As Worksheet
    Dim endUserWB As Workbook
    Dim lastRow As Integer



    'Application.ScreenUpdating = False 'Speeds up the routine by not updating the screen.
    'IMPORTANT, remember to turn screen updating back on before the routine ends


    '***** ENTERING WORKSHEET NAMES *****

    'Get the name of the worksheet to be copied from
    Sheet_Copy_From = Application.InputBox(Prompt:= _
            "Please enter the sheet name you which to copy from", _
            Title:="Sheet_Copy_From", Type:=2) 'Type:=2 = text
    If Sheet_Copy_From = "False" Then 'If Cancel is clicked on Input Box exit sub
        Exit Sub
    End If

    '*****CHECK TO SEE IF WORKSHEETS EXIST (USES FUNCTION AT VERY TOP)*****
    Select Case wsExists(Sheet_Copy_From) 'calling function at very top
        Case False
            MsgBox "The worksheet named """ & Sheet_Copy_From & """ is either missing" & vbNewLine & _
                "or spelt incorrectly" & vbNewLine & vbNewLine & _
                "Please rectify and then run this procedure again" & vbNewLine & vbNewLine & _
                "Select OK to exit", _
                vbInformation, ""
             Exit Sub
     End Select

     Set destWS = ActiveWorkbook.Sheets(Sheet_Copy_From)


    'array of sheet names to test for
     colNames = Array("SID", "First Name", "Last Name", "xyz", "Telephone Number", "Department")

    'Get the name of the worksheet to pasted into
     newSheet = Application.InputBox(Prompt:= _
            "Please enter the sheet name you which to paste in", _
            Title:="New File", Type:=2) 'Type:=2 = text
     If newSheet = "False" Then 'If Cancel is clicked on Input Box exit sub
         Exit Sub
     End If

     Set endUserWB = Workbooks.Add
     endUserWB.SaveAs Filename:=newSheet
     endUserWB.Sheets(1).Name = "Sheet1"
     'endUserWS.Name = "End User"

    'Copy Columns 1 by 1
    i = 1
    For Each col In colNames
        On Error GoTo colNotFound
        colN = destWS.Rows(1).Find(col, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False).Column
        lastRow = destWS.Cells(Rows.Count, colN).End(xlUp).Row
        'MsgBox "Column for " & colN & " is " & lastRow, vbInformation, ""


        'Copy paste Part begins here
        If colN <> -1 Then
            'destWS.Select
            'colVal = destWS.Columns(colN).Select
            'Selection.Copy
            'endUserWB.ActiveSheet.Columns(i).Select
            'endUserWB.ActiveSheet.PasteSpecial Paste:=xlPasteValues
            'endUserWB.Sheets(1).Range(Cells(2, i), Cells(lastRow, i)).Value = destWS.Range(Cells(2, colN), Cells(lastRow, colN))
            destWS.Range(2, lastRow).Copy
            endUserWB.Worksheets("Sheet1").Range(2).PasteSpecial (xlPasteValues)
        End If
        i = i + 1
    Next col
    Application.CutCopyMode = False 'Clears the clipboard
        'MsgBox "Column """ & colN & """ is Found",vbInformation , ""

    colNotFound:
        colN = -1
        Resume Next
 End Sub

What is wrong with code? Any other method to copy? I followed the answer at Copy from one workbook and paste into another as well. But it also gives blank sheet.

Answer 1

If I understood it right try changing this part of your code:

destWS.Range(2, lastRow).Copy
endUserWB.Worksheets("Sheet1").Range(2).PasteSpecial (xlPasteValues)

by:

destWS.Activate
destWS.Range(Cells(2, colN), Cells(lastRow, colN)).Copy
endUserWB.Activate
endUserWB.Worksheets("Sheet1").Cells(2, colN).PasteSpecial (xlPasteValues)