Can't solve "method range of object _Worksheet failed"

Question

The last 2 weeks I have immersed myself in VBA. It's great but since last week I have been struggling with the following error: "VBA method 'range of object' _Worksheet failed" with this line of code:

wsSource.Range(Cells(7, ColumnNr), Cells(lrowSource, ColumnNr)).Copy

I can't find the solution.

This is the entire VBA-code:

Sub CopyColums()
Application.ScreenUpdating = False

cPath = "H:\2017\"
ChDrive cPath
ChDir cPath

cFile = Application.GetOpenFilename("Excel files (*.xls*), *.xls*")
Workbooks.Open cFile, UpdateLinks:=3, ReadOnly:=False, Notify:=False, Password:="****"

Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim lrowSource As Integer

Sheets.Add(After:=Sheets(Sheets.Count)).Name = "import"

Set wsSource = Sheets(1)
Set wsTarget = Sheets("import")

wsTarget.Range("A1").Value = "header 1"
wsTarget.Range("B1").Value = "header 2"
wsTarget.Range("C1").Value = "header 3"
wsTarget.Range("D1").Value = "header 4"
wsTarget.Range("E1").Value = "header 5"
wsTarget.Range("F1").Value = "header 6"
wsTarget.Range("G1").Value = "header 7"
wsTarget.Range("H1").Value = "header 8"
wsTarget.Range("I1").Value = "header 9"
wsTarget.Range("J1").Value = "header 10"
wsTarget.Range("K1").Value = "header 11"
wsTarget.Range("L1").Value = "header 12"
wsTarget.Range("M1").Value = "header 13"
wsTarget.Range("N1").Value = "header 14"

lrowSource = wsSource.Cells(Rows.Count, "A").End(xlUp).Row

'A to A
wsTarget.Range("A2:A" & lrowSource - 5).NumberFormat = "d-m-yy;@" 
wsSource.Range("A7:A" & lrowSource).Copy
wsTarget.Range("A2").PasteSpecial xlPasteValues

'E to B
wsSource.Range("E7:E" & lrowSource).Copy
wsTarget.Range("B2").PasteSpecial xlPasteValues

'F to C
wsSource.Range("F7:F" & lrowSource).Copy
wsTarget.Range("C2").PasteSpecial xlPasteValues

'O to D
wsSource.Range("O7:O" & lrowSource).Copy
wsTarget.Range("D2").PasteSpecial xlPasteValues

'Look for column and copy to I
ColumnNr = Application.Match("Total partner", Sheets(1).Rows(6), 0)
wsSource.Range(Cells(7, ColumnNr), Cells(lrowSource, ColumnNr)).Copy
wsTarget.Range("I2").PasteSpecial xlPasteValues

Application.CutCopyMode = False

'Save as CSV
NameImportFile= Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5) 'to remove .xlsx
Filepath = cPath & NameImportFile& ".csv"
ActiveWorkbook.SaveAs Filename:=Filepath, FileFormat:=xlCSV, CreateBackup:=False, Local:=True

End Sub

Can somebody please help me?

Kind regards, Richard

Answer 1

I'm guessing that Sheets(1) isn't active when that line executes.

If that is the case then wsSource is pointing at Sheets(1) while Cells isn't qualifying the sheet it's using, so it's using the currently active sheet.

Try using:
wsSource.Range(wsSource.Cells(7, ColumnNr), wsSource.Cells(lrowSource, ColumnNr)).Copy.

As an edit (after answer accepted) I'd probably rewrite the procedure:

Option Explicit

Public Sub CopyColumns()

    Dim cPath As String
    Dim cFile As String
    Dim wrkBk As Workbook
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lRowSource As Long
    Dim ColumnNr As Long

    cFile = GetFile("H:\2017\")

    'Continue if a file was selected.
    If cFile <> "" Then
        Set wrkBk = Workbooks.Open(cFile)
        Set wsSource = wrkBk.Worksheets(1)

        'Set a reference to worksheet when it's created.
        Set wsTarget = wrkBk.Worksheets.Add
        With wsTarget
            .Name = "Import"
            .Move After:=wrkBk.Sheets(wrkBk.Sheets.Count)

            'Can use autofill for headers as they're numbered.
            wsTarget.Range("A1") = "Header 1"
            wsTarget.Range("A1").AutoFill Destination:=Range("A1:N1"), Type:=xlFillDefault
            'Could also use
            'wsTarget.Range("A1:N1") = array("Header 1", "Header 2", "Header 3", etc....)

        End With

        'Can use letter or number designation for column in Cells.
        lRowSource = wsSource.Cells(Rows.Count, 1).End(xlUp).Row

        With wsSource
            'This will fail if the lRowSource is 5 or less... lRowSource-5 = 0.
            wsTarget.Range(wsTarget.Cells(2, 1), wsTarget.Cells(lRowSource - 5, 1)).NumberFormat = "d-m-yy;@"
            ColumnNr = Application.Match("Total partner", wsSource.Rows(6), 0)
            'Use UNION to copy columns A,E:F,O & ColumnNr
            Union(.Range(.Cells(7, 1), .Cells(lRowSource, 1)), _
                  .Range(.Cells(7, 5), .Cells(lRowSource, 6)), _
                  .Range(.Cells(7, 15), .Cells(lRowSource, 15)), _
                  .Range(.Cells(7, ColumnNr), .Cells(lRowSource, ColumnNr))).Copy

            wsTarget.Cells(2, 1).PasteSpecial xlPasteValues

        End With

        wsTarget.Copy
        With wrkBk
            'Save with workbook name as CSV.
            ActiveWorkbook.SaveAs .Path & Application.PathSeparator & _
                Left(wrkBk.Name, InStrRev(wrkBk.Name, ".")) & "csv", 6

            'Save with worksheet name as CSV.
            'ActiveWorkbook.SaveAs .Path & Application.PathSeparator & _
               wsTarget.Name & ".csv", 6

        End With

    End If

End Sub

Function GetFile(Optional startFolder As Variant = -1) As Variant
    Dim fle As FileDialog
    Dim vItem As Variant
    Set fle = Application.FileDialog(msoFileDialogFilePicker)
    With fle
        .Title = "Select a File"
        .AllowMultiSelect = False
        .Filters.Add "File to copy columns from", "*.xls*", 1
        If startFolder = -1 Then
            .InitialFileName = Application.DefaultFilePath
        Else
            If Right(startFolder, 1) <> "\" Then
                .InitialFileName = startFolder & "\"
            Else
                .InitialFileName = startFolder
            End If
        End If
        If .Show <> -1 Then GoTo NextCode
        vItem = .SelectedItems(1)
    End With
NextCode:
    GetFile = vItem
    Set fle = Nothing
End Function