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 aangepast door huijb : 19 september 2023 om 16:03
Je code is leesbaarder als je de juiste code tags gebruikt #
VBA voor smarties
VBA is een taal die je moet leren met een grammatica- en een woordenboek.
http://www.helpmij.nl/forum/announcement.php?f=5
Plaats svp geen bestanden op andere sites; nadat het bestand daar verwijderd is wordt een forumdraad onbegrijpelijk voor anderen.
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.
Gebruik de QUOTE knop alleen als je iets wit citeren.
Op deze pagina kun je zien hoe je met TAGS werkt.
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 aangepast door huijb : 19 september 2023 om 18:30
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.
VBA voor smarties
VBA is een taal die je moet leren met een grammatica- en een woordenboek.
http://www.helpmij.nl/forum/announcement.php?f=5
Plaats svp geen bestanden op andere sites; nadat het bestand daar verwijderd is wordt een forumdraad onbegrijpelijk voor anderen.