简体   繁体   English

Excel VBA,下标超出范围

[英]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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM