Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
184 views
in Technique[技术] by (71.8m points)

Excel VBA selecting a cell getting error 1004 Select Range class failed

The code below is a template used for a bunch of automations. all works fine until the line where i'm trying to select a certain cell. I'm doing that so that if somewhere in the code I add some code that manipulates a cell somewhere far in the document, I want it to select the first cell with data (in my case it's a variable ExcelPasteTo), so that when the user open the file,it doesn't shift to cell AZX298, for example.

So far, i'm getting stuck at this line .Range(ExcelPasteTo).Select what's weird is, in the case, this code creates 2 files, first file has 1 sheet, second has 8 sheets. it works fine for the first file, selects the correct cell, saves, closes, opens the second one, pastes the data and then gets stuck at this line the error is Error 1004 Select method of Range class failed

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
question from:https://stackoverflow.com/questions/65886973/excel-vba-selecting-a-cell-getting-error-1004-select-range-class-failed

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

So all I'm trying to do is to make sure that after all manipulations, the document always opens at the beginning. And I was doing that by selecting A2 or A3

Is this what you are trying?

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

Note: For this to work, ensure that the Sheet is visible and unprotected. And if protected, then "Select locked cells" is activated.


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...