Private Sub CommandButton1_Click() doorlussen

[ozzyozzy]

Graag wil ik met 1 macro button 2 bestanden inlezen op verschillende positie. mij is het niet gelukt om de onderstaande door te lussen. Heeft iemand een optie hoe je dit beste kan doen?

Private Sub CommandButton1_Click()
  c00 = ThisWorkbook.Path & "\Productie ok.xls"
  With GetObject(c00)
    ar = .Sheets(1).Cells(1).CurrentRegion
    .Close 0
  End With
  
  y = Application.Transpose(Application.Index(ar, 0, 1))
  ar1 = Sheets("ok").Cells(3, 1).CurrentRegion.Resize(, 19)

  For j = 2 To UBound(ar1)
    x = Application.Match(ar1(j, 1), y, 0)
    If IsNumeric(x) Then
      For jj = 2 To 19
        ar1(j, jj) = ar(x, jj)
      Next jj
    End If
  Next j
  Sheets("ok").Cells(3, 1).CurrentRegion.Resize(, 19) = ar1
End With




c00 = ThisWorkbook.Path & "\Productie ok1.xls"
  With GetObject(c00)
    ar = .Sheets(1).Cells(1).CurrentRegion
    .Close 0
  End With
  
  y = Application.Transpose(Application.Index(ar, 0, 1))
  ar1 = Sheets("ok").Cells(34, 1).CurrentRegion.Resize(, 19)

  For j = 2 To UBound(ar1)
    x = Application.Match(ar1(j, 1), y, 0)
    If IsNumeric(x) Then
      For jj = 2 To 19
        ar1(j, jj) = ar(x, jj)
      Next jj
    End If
  Next j
  Sheets("ok").Cells(34, 1).CurrentRegion.Resize(, 19) = ar1
End If

End Sub

 

[snb]

Je code is leesbaarder als je de juiste code tags gebruikt #

 

[OctaFish]

En als je naar je code kijkt, zie je dat regel 20 overbodig is, en regel 43 ook. Dus de procedure gaat sowieso niet werken.

 

[ozzyozzy]

ik heb met call alle excel documenten ingelezen.

nog ander idee?

Private Sub CommandButton1_Click()

Call CommandButton2_Click
Call CommandButton3_Click
Call CommandButton4_Click


End Sub


Private Sub CommandButton2_Click()
  c00 = ThisWorkbook.Path & "\ok1.xls"
  With GetObject(c00)
    ar = .Sheets(1).Cells(1).CurrentRegion
    .Close 0
  End With
  
  y = Application.Transpose(Application.Index(ar, 0, 1))
  ar1 = Sheets("ok").Cells(11, 1).CurrentRegion.Resize(, 16)

  For j = 2 To UBound(ar1)
    x = Application.Match(ar1(j, 1), y, 0)
    If IsNumeric(x) Then
      For jj = 2 To 16
        ar1(j, jj) = ar(x, jj)
      Next jj
    End If
  Next j
  Sheets("ok").Cells(11, 1).CurrentRegion.Resize(, 16) = ar1
End Sub




Private Sub CommandButton3_Click()
c00 = ThisWorkbook.Path & "\ok2.xls"
  With GetObject(c00)
    ar = .Sheets(1).Cells(1).CurrentRegion
    .Close 0
  End With
  
  y = Application.Transpose(Application.Index(ar, 0, 1))
  ar1 = Sheets("ok").Cells(11, 18).CurrentRegion.Resize(, 16)

  For j = 2 To UBound(ar1)
    x = Application.Match(ar1(j, 1), y, 0)
    If IsNumeric(x) Then
      For jj = 2 To 16
        ar1(j, jj) = ar(x, jj)
      Next jj
    End If
  Next j
  Sheets("ok").Cells(11, 18).CurrentRegion.Resize(, 16) = ar1
End Sub


Private Sub CommandButton4_Click()
c00 = ThisWorkbook.Path & "\ok3.xls"
  With GetObject(c00)
    ar = .Sheets(1).Cells(1).CurrentRegion
    .Close 0
  End With
  
  y = Application.Transpose(Application.Index(ar, 0, 1))
  ar1 = Sheets("ok").Cells(11, 35).CurrentRegion.Resize(, 16)

  For j = 2 To UBound(ar1)
    x = Application.Match(ar1(j, 1), y, 0)
    If IsNumeric(x) Then
      For jj = 2 To 16
        ar1(j, jj) = ar(x, jj)
      Next jj
    End If
  Next j
  Sheets("ok").Cells(11, 35).CurrentRegion.Resize(, 16) = ar1
End Sub

 

[snb]

Geef eens een voorbeeld van een uit te lezen bestand en het betand waarin die gegevens terecht moeten komen.

Het kan natuurlijk in een lus for j=1 to 3 in plaats van 3 knoppen.