Программа VBA выдает ошибку 1004 при открытии рабочей книги - PullRequest
Новая
       2

Программа VBA выдает ошибку 1004 при открытии рабочей книги

0 голосов
/ 12 июня 2019

У меня есть этот код в vba для открытия 100 книг и вставки некоторых значений в другую книгу, но код vba открывает только одну книгу и правильно вставляет значения, когда появляется вторая итерация и появляется ошибка 1004, я не уверен, почемуЯ перепробовал много способов, которые нашел, но это то же самое.Кроме того, когда я нажимаю F8, код все еще выполняется и хорошо завершается, поэтому я не уверен, что мой код неверен или нет. 

    Sub AutomatizadoCompleto()

'Paso 1: Declarar las variables

 Dim Archivos As String
 Dim vals, Tomado As Variant
 Dim vals1, valor1, valor2, valorConstante1, valorConstante2 As Variant
 Dim vals2 As Variant
 Dim vals3 As Variant
 Dim vals4 As Variant`enter code here`
 Dim vals5 As Variant
 Dim vals6, variable As Variant
 Dim vals11, vals22, vals33, vals44 As Variant
Dim ValueinCell, ValueinCell1 As Variant
Dim x As Variant
Dim lote1, lote2, lote3, lote4, lote5, lote6, lote7, lote8, lote11, lote22, lote33, lote44, lote55, lote66, lote77, lote88 As Variant
Dim ruta, ruta2 As String
 Dim wbcopy As Workbook
Dim wbTarget As Workbook

Dim wsFrom As Worksheet
Dim wsTarget, wsTarget2 As Worksheet
Dim i As String
Dim FirstColumnDetalleOb1, FirstColumnTabulado1, FirstColumnDetalleOb, FirstColumnTabulado, lastColumnFinal1, lastColumnFinal2 As Variant

i = (InputBox("Ingrese ruta donde se encuentren carpetas", "Ruta carpeta"))        'recuperamos las cadena del input box



Set wbTarget = ActiveWorkbook
Set wsTarget = wbTarget.Worksheets("TABULADO")
Set wsTarget2 = wbTarget.Worksheets("DETALLE DE OBS")

wsTarget2.Activate

FirstColumnDetalleOb1 = wsTarget2.Range("H6").End(xlToRight).Column

FirstColumnDetalleOb = wsTarget2.Range("H6").End(xlToRight).Offset(0, 1).Column



wsTarget.Activate

FirstColumnTabulado1 = wsTarget.Range("G10").End(xlToRight).Column

FirstColumnTabulado = wsTarget.Range("G10").End(xlToRight).Offset(0, 1).Column


    Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

    ruta = i & "\*.xlsx"
    ruta2 = i & "\"
    Debug.Print ruta
    Archivos = Dir(ruta)
    Debug.Print Archivos
 'Archivos = Dir("C:\Users\fernandofernandez\Desktop\Prueba\*.xlsx") usar este en caso se malogre el input
   If Archivos = "" Then

    MsgBox "NO HICE NADA!, FAVOR Volver a correr Macro"

    variable = "k"
End If


 Do While Archivos <> ""

 'Workbooks.Open "C:\Users\fernandofernandez\Desktop\Prueba\" & Archivos  Usar este en caso se malogre

    Workbooks.Open ruta2 & Archivos

    Set wbcopy = Workbooks.Open(ruta2 & Archivos)

    'code

    With wbcopy

     wbcopy.Activate
     Worksheets("Hoja1").Activate

     Debug.Print wbcopy.Name
     ' copiar tabulado'
    'D2 CODIGO'
    vals1 = wbcopy.Worksheets("Hoja1").Range("D2").Value
    'C2 LOCALIDAD'
    vals2 = wbcopy.Worksheets("Hoja1").Range("C2").Value
    'G2 FECHA DE VISITA'
    vals8 = wbcopy.Worksheets("Hoja1").Range("G2").Value
    'Supervisor'
    vals44 = wbcopy.Worksheets("Hoja1").Range("H2").Value


    'primer lote cumple no cumple'
    lote1 = wbcopy.Worksheets("Hoja1").Range("M2:M4").Value
  ' segundo lote'
    lote2 = wbcopy.Worksheets("Hoja1").Range("M5:M13").Value
    ' tercera lote'
    lote3 = wbcopy.Worksheets("Hoja1").Range("M14:M20").Value
    ' cuarto lote'
  lote4 = wbcopy.Worksheets("Hoja1").Range("M21:M28").Value
   '5to lote'
   lote5 = wbcopy.Worksheets("Hoja1").Range("M29:M32").Value
  ' lote 6'
  lote6 = wbcopy.Worksheets("Hoja1").Range("M33:M34").Value
    'lote 7'
  lote7 = wbcopy.Worksheets("Hoja1").Range("M35:M36").Value
' lote 8'
  lote8 = wbcopy.Worksheets("Hoja1").Range("M37:M41").Value


' copiar
    lote11 = wbcopy.Worksheets("Hoja1").Range("N2:N4").Value
  ' segundo lote'
    lote22 = wbcopy.Worksheets("Hoja1").Range("n5:n13").Value
    ' tercera lote'
    lote33 = wbcopy.Worksheets("Hoja1").Range("n14:n20").Value
    ' cuarto lote'
  lote44 = wbcopy.Worksheets("Hoja1").Range("n21:n28").Value
   '5to lote'
   lote55 = wbcopy.Worksheets("Hoja1").Range("n29:n32").Value
  ' lote 6'
  lote66 = wbcopy.Worksheets("Hoja1").Range("n33:n34").Value
    'lote 7'
  lote77 = wbcopy.Worksheets("Hoja1").Range("n35:n36").Value
' lote 8'
  lote88 = wbcopy.Worksheets("Hoja1").Range("n37:n41").Value

    End With

    With wbTarget

    Debug.Print wbTarget.Name
    wbTarget.Activate
    wsTarget.Activate   'TABULADO'

    wsTarget.Range("G6").Select
    wsTarget.Range("G6").End(xlToRight).Select
    Selection.EntireColumn.Select
    Selection.Copy
    wsTarget.Range("G6").Select
    wsTarget.Range("G6").End(xlToRight).Offset(0, 1).Select
    Selection.EntireColumn.Select
    Selection.PasteSpecial xlPasteFormats
    Selection.PasteSpecial xlPasteValues
    Application.CutCopyMode = False


     wsTarget.Range("G6").End(xlToRight).EntireColumn.Select
    Selection.ClearContents

   ValueinCell = wsTarget.Range("G6").End(xlToRight).Column
   ValueinCell1 = ValueinCell + 1

    Debug.Print ValueinCell
    Debug.Print ValueinCell1c

    valorConstante1 = wsTarget.Cells(10, ValueinCell).Copy
    wsTarget.Cells(10, ValueinCell1).PasteSpecial xlPasteValues
    Debug.Print "valor constante1:" & valorConstante1

    wsTarget.Range(Cells(12, ValueinCell1), Cells(14, ValueinCell1)).Value = lote1
    wsTarget.Range(Cells(16, ValueinCell1), Cells(24, ValueinCell1)).Value = lote2
    wsTarget.Range(Cells(26, ValueinCell1), Cells(32, ValueinCell1)).Value = lote3
    wsTarget.Range(Cells(34, ValueinCell1), Cells(41, ValueinCell1)).Value = lote4
    wsTarget.Range(Cells(43, ValueinCell1), Cells(46, ValueinCell1)).Value = lote5
    wsTarget.Range(Cells(48, ValueinCell1), Cells(49, ValueinCell1)).Value = lote6
    wsTarget.Range(Cells(51, ValueinCell1), Cells(52, ValueinCell1)).Value = lote7
    wsTarget.Range(Cells(54, ValueinCell1), Cells(58, ValueinCell1)).Value = lote8


    wsTarget.Cells(6, ValueinCell1).Value = vals1
    wsTarget.Cells(7, ValueinCell1).Value = vals2
     wsTarget.Cells(8, ValueinCell1).Value = vals44
      wsTarget.Cells(9, ValueinCell1).Value = vals8

End With

'otra etapa

With wsTarget2

wsTarget2.Activate

    wsTarget2.Range("H4").Select
    wsTarget2.Range("H4").End(xlToRight).Select
    Selection.EntireColumn.Select
    Selection.Copy
    wsTarget2.Range("H4").Select
    wsTarget2.Range("H4").End(xlToRight).Offset(0, 1).Select
    Selection.EntireColumn.Select
    Selection.PasteSpecial xlPasteFormats
    Selection.PasteSpecial xlPasteValues
    Application.CutCopyMode = False



    wsTarget2.Range("H4").End(xlToRight).EntireColumn.Select
    Selection.ClearContents

   ValueinCell = wsTarget2.Range("H4").End(xlToRight).Column
   ValueinCell1 = ValueinCell + 1

    valorConstante2 = wsTarget2.Cells(8, ValueinCell).Copy


    wsTarget2.Cells(8, ValueinCell1).PasteSpecial xlPasteValues

    wsTarget2.Range(Cells(10, ValueinCell1), Cells(12, ValueinCell1)).Value = lote11
    wsTarget2.Range(Cells(14, ValueinCell1), Cells(22, ValueinCell1)).Value = lote22
    wsTarget2.Range(Cells(24, ValueinCell1), Cells(30, ValueinCell1)).Value = lote33
    wsTarget2.Range(Cells(32, ValueinCell1), Cells(39, ValueinCell1)).Value = lote44
    wsTarget2.Range(Cells(41, ValueinCell1), Cells(44, ValueinCell1)).Value = lote55
    wsTarget2.Range(Cells(46, ValueinCell1), Cells(49, ValueinCell1)).Value = lote66
    wsTarget2.Range(Cells(51, ValueinCell1), Cells(55, ValueinCell1)).Value = lote88


    lote11 = wbcopy.Worksheets("Hoja1").Range("N2:N4").Value
  ' segundo lote'
    lote22 = wbcopy.Worksheets("Hoja1").Range("n5:n13").Value
    ' tercera lote'
    lote33 = wbcopy.Worksheets("Hoja1").Range("n14:n20").Value
    ' cuarto lote'
  lote44 = wbcopy.Worksheets("Hoja1").Range("n21:n28").Value
   '5to lote'
   lote55 = wbcopy.Worksheets("Hoja1").Range("n29:n32").Value
  ' lote 6'
  lote66 = wbcopy.Worksheets("Hoja1").Range("n33:n36").Value
    'lote 7'
  'lote77 = wbcopy.Worksheets("Hoja1").Range("n35:n36").Value
' lote 8'
  lote88 = wbcopy.Worksheets("Hoja1").Range("n37:n41").Value



    wsTarget2.Cells(4, ValueinCell1).Value = vals1
    wsTarget2.Cells(5, ValueinCell1).Value = vals2
    wsTarget2.Cells(6, ValueinCell1).Value = vals44
    wsTarget2.Cells(7, ValueinCell1).Value = vals8


End With



 'Paso 5: Cuadro de mensaje, cerrar y guardar cambios

 'MsgBox ActiveWorkbook.Name
Application.EnableEvents = False
 wbcopy.Close 'SaveChanges:=True

 Archivos = Dir
 Loop

If variable = "k" Then
MsgBox "Intentar nuevamente!"
  'Reset Macro Optimization Settings


    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

Else

  With wsTarget2

  wsTarget2.Activate

  lastColumnFinal1 = wsTarget2.Range("G4").End(xlToRight).Column
  Debug.Print "Fila final detalleobj:" & lastColumnFinal1

    x = 1
    For Each Cell In wsTarget2.Range(Cells(3, FirstColumnDetalleOb), Cells(3, lastColumnFinal1))

   'DETALLE OBSERVACION

        Cell.Value = x
            'If x = 1 Then
            'wsTarget2.Cells(1, FirstColumnDetalleOb) = x
       ' Else
           ' wsTarget2.Cells(1, FirstColumnDetalleOb + x) = x
       ' End If
       x = x + 1


    Next Cell


    End With




   With wsTarget

   wsTarget.Activate

       lastColumnFinal2 = wsTarget.Range("G9").End(xlToRight).Column

    x = 1

  For Each Cell In wsTarget.Range(Cells(5, FirstColumnTabulado), Cells(5, lastColumnFinal2))


    Cell.Value = x

       ' If x = 1 Then
            'wsTarget.Cells(3, FirstColumnTabulado) = x
       ' Else
        ' wsTarget.Cells(3, FirstColumnTabulado + x) = x
        'End If


           x = x + 1

    Next Cell


    End With

 MsgBox "Toda la tarea completada!"
  'Reset Macro Optimization Settings


    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End If



End Sub

Я также присоединяю строку, когда де-код останавливается.

enter image description here

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...