无法解决"method range of object _Worksheet failed"

Question

在过去的两周里，我沉浸在VBA中。这很棒，但自上周以来，我一直在为以下错误而苦苦挣扎："VBA 方法'对象范围'_Worksheet失败"使用以下代码行：

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

我找不到解决方案。

这是整个VBA代码：

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

有人可以帮我吗？

亲切问候理查

Answer 1

我猜Sheets(1)在该行执行时不处于活动状态。

如果是这种情况，则wsSource指向Sheets(1)，而Cells没有限定它正在使用的工作表，因此它使用的是当前活动的工作表。

尝试使用：
wsSource.Range(wsSource.Cells(7, ColumnNr), wsSource.Cells(lrowSource, ColumnNr)).Copy .

作为编辑(在接受答案后(，我可能会重写该过程：

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