Excel VBA选择一个单元格遇到错误1004 Select Range类失败 [英] Excel VBA selecting a cell getting error 1004 Select Range class failed
问题描述
下面的代码是用于大量自动化的模板.一切正常，直到我试图选择某个单元格的那一行.我这样做是为了，如果在代码中的某个位置添加一些代码来操纵文档中某个位置的某个单元格，我希望它选择包含数据的第一个单元格(在我的情况下，它是一个变量ExcelPasteTo)，以便当用户打开文件，例如，它不会移到AZX298单元格.
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.
到目前为止，我被这条线卡住了.Range(ExcelPasteTo).选择奇怪的是，在这种情况下，此代码创建了2个文件，第一个文件有1张纸，第二个文件有8张纸.对于第一个文件，它工作正常，选择正确的单元格，保存，关闭，打开第二个文件，粘贴数据，然后卡在此行错误是错误1004Range类的选择方法失败
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
推荐答案
因此，我要做的就是确保在进行所有操作后，文档始终在开头打开.我通过选择A2或A3来做到这一点
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
这是您要尝试的吗?
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.
这篇关于Excel VBA选择一个单元格遇到错误1004 Select Range类失败的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
