[英]Excel VBA , subscript out of range
so i started writting a code that would write from Workbook1 UserForm to WorkBook2 sheet. 所以我开始写一个将从Workbook1 UserForm写入WorkBook2工作表的代码。 For some unknown reason it's not copying the data .
由于某些未知原因,它没有复制数据。
Private Sub CommandButton1_Click()
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Dim src As Workbook
' Open EXCEL
Set src = Workbooks.Open("U:\Mecânica\Produção\63177 - Qualidade\Rejeição Interna\Dados\Gaspar\Projeto Manutenção.xlsm", True, False)
WS_Count = src.Worksheets.Count
For o = 1 To WS_Count
src.Worksheets(o).Unprotect password:="projmanutencao"
Next o
last = src.Worksheets(Manutencao).Range("A65536").End(xlUp).Row
' Write regists
src.Worksheets(Manutencao).Cells(last + 1, 1) = Now() 'data
src.Worksheets(Manutencao).Cells(last + 1, 2) = manutencaoexp.ComboBox3 'nº equipamento
src.Worksheets(Manutencao).Cells(last + 1, 3) = manutencaoexp.ComboBox5 'avaria
src.Worksheets(Manutencao).Cells(last + 1, 4) = manutencaoexp.ComboBox4 'serviços
' src.Worksheets(Manutencao).Cells(last + 1, 5) = Velocidade 'produtos
' src.Worksheets(Manutencao).Cells(last + 1, 6) = Qualidade 'duração
' src.Worksheets(Manutencao).Cells(last + 1, 7) = Data 'operario
src.Worksheets(Manutencao).Cells(last + 1, 8) = manutencaoexp.ComboBox6 'tipo de manutenção
For o = 1 To WS_Count
src.Worksheets(o).Protect password:="projmanutencao"
Next o
Application.DisplayAlerts = False 'IT WORKS TO DISABLE ALERT PROMPT
'SAVES FILE USING THE VARIABLE BOOKNAME AS FILENAME
src.Save
Application.DisplayAlerts = True 'RESETS DISPLAY ALERTS
' CLOSE THE SOURCE FILE.
src.Close True ' FALSE - DON'T SAVE THE SOURCE FILE.
Set src = Nothing
ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
If someone can help fix this piece of code , or maybe have a code that copies from a diferente workbook userform . 如果有人可以帮助修复这段代码,或者拥有从不同工作簿用户表单中复制的代码。 I'm getting a subscript out of range error in
我的下标超出范围错误
last = src.Worksheets(Manutenção).Range("A65536").End(x1Up).Row
Assuming 'Manutencao' is the worksheet name, then change this line to: 假设“ Manutencao”是工作表名称,然后将此行更改为:
last = src.Worksheets("Manutencao").Range("A65536").End(xlUp).Row
Note the ""
around the worksheet name. 注意工作表名称周围的
""
。 You'll have to change this wherever you reference this worksheet. 无论您在哪里引用此工作表,都必须更改此设置。
EDIT: Your code could be rewritten like this, to be a little clearer; 编辑:您的代码可以像这样重写,更清晰一些;
Private Sub CommandButton1_Click()
Dim src As Workbook
Dim last As Long
On Error GoTo ErrHandler
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
End With
Set src = Workbooks.Open("U:\Mecânica\Produção\63177 - Qualidade\Rejeição Interna\Dados\Gaspar\Projeto Manutenção.xlsm", True, False)
With src.Worksheets("Manutencao")
.Unprotect Password:="projmanutencao"
last = .Cells(Rows.Count, "A").End(xlUp).Row
.Cells(last + 1, 1) = Now() 'data
.Cells(last + 1, 2) = manutencaoexp.ComboBox3 'nº equipamento
.Cells(last + 1, 3) = manutencaoexp.ComboBox5 'avaria
.Cells(last + 1, 4) = manutencaoexp.ComboBox4 'serviços
' .Cells(last + 1, 5) = Velocidade 'produtos
' .Cells(last + 1, 6) = Qualidade 'duração
' .Cells(last + 1, 7) = Data 'operario
.Cells(last + 1, 8) = manutencaoexp.ComboBox6 'tipo de manutenção
.Protect Password:="projmanutencao"
End With
src.Close True ' FALSE - DON'T SAVE THE SOURCE FILE.
Set src = Nothing
ErrHandler:
If Err Then
Debug.Print "Error", Err.Number, Err.Description
Err.Clear
With Application
.EnableEvents = True
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.