Excel VBA选择单元格出现错误1004选择范围类失败

Question

下面的代码是用于一堆自动化的模板。一切正常，直到我试图选择某个单元格的那一行。我这样做是为了如果在代码中的某处添加一些代码来操作文档中某处的某个单元格，我希望它选择第一个带有数据的单元格（在我的情况下它是一个变量 ExcelPasteTo），这样当用户打开文件，它不会转移到单元格 AZX298，例如。

到目前为止，我被困在这条线上 .Range(ExcelPasteTo).Select 奇怪的是，在这种情况下，这段代码创建了 2 个文件，第一个文件有 1 张，第二个有 8 张。它适用于第一个文件，选择正确的单元格，保存，关闭，打开第二个文件，粘贴数据然后卡在这一行 错误是 错误 1004 Range 类的 Select 方法失败

Option Explicit

Public Sub MainProcedure1()

    Dim FormattedDate As Date, RunDate As Date

    Dim ReportPath As String, MonthlyPath As String, CurPath As String, ProjectName As String, ExcelFileName As String, FinalExcelFileName As String
    Dim TableName As String, TemplateFileName As String, SheetToSelect As String, ExcelSheetName As String, CurSheetName As String
    
    Dim CurRowNum As Long, LastRow As Long, FirstRowOfSection As Long, LastRowOfSection As Long
    Dim i     As Integer, CurCell As Variant, CurRange As Range
    Dim wbkM  As Workbook, wbkNewFile   As Workbook, wbk2   As Workbook, wbk3   As Workbook, wbk4   As Workbook
    Dim wksReportDates As Worksheet, wksFilesToExportEMail  As Worksheet, wksCopyFrom   As Worksheet, wksCopyTo   As Worksheet, wks3  As Worksheet, wks4   As Worksheet, wks5  As Worksheet
    Dim rngCopyFrom As Range, rngCopyTo As Range
    Dim Offset1 As Long, Offset2 As Long
    
        
    Application.EnableCancelKey = xlDisabled
    Application.DisplayAlerts = False
    Application.EnableEvents = False

    CurPath = ThisWorkbook.Path & "\"
    CurRowNum = 2
        
    With ThisWorkbook.Sheets("QReportDates")
        FormattedDate = .Range("A2").Value
        RunDate = .Range("B2").Value
        ReportPath = .Range("C2").Value
        MonthlyPath = .Range("D2").Value
        ProjectName = .Range("E2").Value
    End With
    

    Set wbkM = Workbooks(ProjectName & ".xlsm")
    Set wksReportDates = wbkM.Sheets("QReportDates")
    Set wksFilesToExportEMail = wbkM.Sheets("QFilesToExportEMail")
    
    With wksFilesToExportEMail
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    
        Set CurRange = .Range("B" & CurRowNum & ":B" & LastRow)

        For Each CurCell In CurRange
            If CurCell <> "" Then
 
                ExcelFileName = .Range("B" & CurRowNum).Value
                FinalExcelFileName = .Range("B" & CurRowNum).Value
                LastRowOfSection = .Range("B" & CurRowNum & ":B" & LastRow).Find(what:=ExcelFileName, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, searchdirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).Row
                TemplateFileName = .Range("F" & CurRowNum).Value
                FirstRowOfSection = .Columns(2).Find(ExcelFileName).Row
                TableName = .Range("A" & CurRowNum).Value
                ExcelSheetName = .Range("C" & CurRowNum).Value
                                                            
                If ExcelSheetName = "" Then
                    ExcelSheetName = TableName
                End If
                                                            
                If CurRowNum = FirstRowOfSection Then
                    SheetToSelect = ExcelSheetName
                End If
                                       
                If IsNull(TemplateFileName) Or TemplateFileName = "" Then
                    Set wbkNewFile = Workbooks.Add
                Else
                    Set wbkNewFile = Workbooks.Open(CurPath & TemplateFileName)
                End If
                                       
                wbkNewFile.SaveAs MonthlyPath & FinalExcelFileName
                                   
                For i = CurRowNum To LastRowOfSection
                                                                                 
                    With wksFilesToExportEMail
                        TableName = .Range("A" & i).Value
                        ExcelSheetName = .Range("C" & i).Value
                        ExcelTemplate = .Range("D" & i).Value
                        ExcelPasteTo = .Range("E" & i).Value
                    End With
                                                        
                    If ExcelSheetName = "" Then
                        ExcelSheetName = TableName
                    End If
                                       
                    Set wksCopyFrom = wbkM.Sheets(TableName)
                    Set wksCopyTo = wbkNewFile.Sheets(ExcelSheetName)
                        
                    If ExcelTemplate = "format" Then
                                                                      
                        Set wbkNewFile = Workbooks(FinalExcelFileName)
                        wbkNewFile.Sheets.Add(after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)).Name = ExcelSheetName
    
                        With wksCopyFrom
                            CurLastColumn = MyColumnLetter(.Range("A1").CurrentRegion.Columns.Count)
                            CurLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
                            Set rngCopyFrom = .Range("A1:" & CurLastColumn & CurLastRow)
                        End With
            
            
                        With wksCopyTo
                            Offset1 = Range(CurLastColumn & CurLastRow).Row + (Range(ExcelPasteTo).Row - 1)
                            Offset2 = Range(CurLastColumn & CurLastRow).Column + (Range(ExcelPasteTo).Column - 1)
                            Set rngCopyTo = .Range(.Cells(Range(ExcelPasteTo).Row, Range(ExcelPasteTo).Column), .Cells(Offset1, Offset2))
                        End With
                        
                        rngCopyTo.Value = rngCopyFrom.Value
                        
                        Application.Run "'personal.xlsb'!FormatTheBasics"
                        
                    ElseIf ExcelTemplate = "" Then
                                                                       
                        With wksCopyFrom
                            CurLastColumn = MyColumnLetter(.Range("A1").CurrentRegion.Columns.Count)
                            CurLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
                            Set rngCopyFrom = .Range("A2:" & CurLastColumn & CurLastRow)
                        End With
                                                                      
                        With wksCopyTo
                            Offset1 = Range(CurLastColumn & CurLastRow).Row + (Range(ExcelPasteTo).Row - 2)
                            Offset2 = Range(CurLastColumn & CurLastRow).Column + (Range(ExcelPasteTo).Column - 1)
                            Set rngCopyTo = .Range(.Cells(Range(ExcelPasteTo).Row, Range(ExcelPasteTo).Column), .Cells(Offset1, Offset2))
                        End With
                        
                        rngCopyTo.Value = rngCopyFrom.Value
                                                                      
                    ElseIf ExcelTemplate Like "*TEMPLATE*" Then
                                        
                        wbkM.Sheets(ExcelTemplate).Copy after:=wbkNewFile.Sheets(1)
                        wbkM.Sheets(1).Name = ExcelSheetName
                        wbkM.Sheets(ExcelSheetName).Move after:=Workbooks(Workbooks.Count)
                                                                                   
                        wbkNewFile.wksCopyTo.Select
                                                           
                        With wksCopyFrom
                            CurLastColumn = MyColumnLetter(.Range("A1").CurrentRegion.Columns.Count)
                            CurLastRow = Cells(Rows.Count, "A").End(xlUp).Row
                            Set rngCopyFrom = .Range("A2:" & CurLastColumn & CurLastRow)
                        End With
                         
                        With wksCopyTo
                            'A2 = (2,1)
                            Offset1 = Range(CurLastColumn & CurLastRow).Row + (Range(ExcelPasteTo).Row - 2)
                            Offset2 = Range(CurLastColumn & CurLastRow).Column + (Range(ExcelPasteTo).Column - 1)
                            Set rngCopyTo = .Range(.Cells(Range(ExcelPasteTo).Row, Range(ExcelPasteTo).Column), .Cells(Offset1, Offset2))
                        End With
                        
                        rngCopyTo.Value = rngCopyFrom.Value
                                                                      
                    End If
                        
                        With wksCopyTo
                            .Range(ExcelPasteTo).Select
                        End With
                                                        
                Next i
                                                                 
                If LastRowOfSection < LastRow Then
                    CurRowNum = LastRowOfSection + 1
                Else
                    CurRowNum = LastRowOfSection
                End If
            
            End If
        
            With wksCopyTo
                If CheckSheet("Sheet1") Then
                    Worksheets("Sheet1").Delete
                End If
            End With
                     
            wbkNewFile.Worksheets(SheetToSelect).Select
            wbkNewFile.Save
            wbkNewFile.Close
            Set wbkNewFile = Nothing
            Set wksCopyTo = Nothing
            Set rngCopyTo = Nothing
            Set wksCopyFrom = Nothing
            Set rngCopyFrom = Nothing
            
            If LastRowOfSection >= LastRow Then
                Exit For
            End If
        Next CurCell

        CurSheetName = ""

        With wksFilesToExportEMail
            LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
    
            Set CurRange = .Range("A2:A" & LastRow)
            For Each CurCell In CurRange
                If CurCell <> "" Then
                    CurSheetName = CurCell
    
                    If CheckSheet(CurSheetName) Then
                        Worksheets(CurSheetName).Delete
                    End If
    
                End If
            Next CurCell
        End With
        
    End With
    
    wbkM.Worksheets("QFilesToExportEMail").Delete
    wbkM.Worksheets("QReportDates").Delete
    wbkM.Save

    Set CurCell = Nothing: Set CurRange = Nothing: Set wbkM = Nothing
End Sub

Answer 1

所以我要做的就是确保在所有操作之后，文档总是在开头打开。我通过选择 A2 或 A3 来做到这一点

这是你正在尝试的吗？

Application.Goto Reference:=ws.Range("A2"), Scroll:=True

注意：为此，请确保工作表可见且不受保护。如果受到保护，则会激活“选择锁定的单元格”。