• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Private Sub CommandButton1_Click() doorlussen

Status
Niet open voor verdere reacties.
O

ozzyozzy

Gebruiker
Lid geworden
3 jul 2009
Berichten
126
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?

Code: 
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
 
Laatst bewerkt door een moderator:
Je code is leesbaarder als je de juiste code tags gebruikt #
 
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.
 
ik heb met call alle excel documenten ingelezen.

nog ander idee?



Code: 
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
 
Laatst bewerkt door een moderator:
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.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan