importeren gegevens uit ander excel bestand

Status
Niet open voor verdere reacties.
Staat er geen data in cel B16 en verder naar onderen van dat bestand?
 
De popup komt wel in beeld maar als ik week spatie jaar invoer en dan enter gebeurd er niks
 
Misschien kun je dat bestand plaatsen.
Incl. bestandsnaam.
 
Hij importeert wel week 12 maar niet week 13 of 14
Heb het bestand bijgevoegd
 

Bijlagen

  • voorbeeld bestand 1.xlsb
    27,9 KB · Weergaven: 22
Ik wil graag het bestand inzien dat geïmporteerd moet worden.

Week 13 en of 14.
 
Heb het al gevonden, had de loslijst opgeslagen als week 13 maar in het bestand zelf stonden de datums nog op deze week.
Daarom deed die het niet.
 
Harry,

Bij deze nog hartstikke bedankt voor de code en de snelle hulp.
Ben hier ontzettend blij mee, mocht ik in de toekomst nog wat zoeken kan ik dan weer beroep op je doen?
 
Graag gedaan; je kan altijd een beroep op dit forum doen, dat hoef ik niet specifiek te zijn natuurlijk.
 
Top,

Nu zit ik nog even met het volgende, ik weet niet of je het voorbeeld van de loslijst nog hebt?
Maar er stonden per dag 3 lossingen op, nu is het veranderd naar 4 lossingen op een dag.
Nu werkt de code niet meer met importeren, wat moet hier in aangepast worden?

Ik heb de voorbeeld bestanden even bijgevoegd:
Dit is de code die ik had van jou had voor 3 lossingen per dag.

Code:
Sub ImportNow()
Dim sv, r, i As Long, arr(8, 6), n As Long, j As Long, k As Long, Wb As Worksheet
Set Wb = ThisWorkbook.Sheets("blad1")
With GetObject("E:\Excel\Lossing\IJ_lossing " & Application.InputBox("typ het weeknummer + spatie + jaartal", "openen", "bv. 12 2019", , , , , 2) & ".xls")
sv = .Sheets("loslijst ijmuiden").Range("a16:j38")
 For i = 1 To UBound(sv)
   r = Application.Match(CLng(sv(i, 2)), Wb.Rows(2), 0)
   If IsNumeric(r) Then
     If k = 0 Then k = r
     arr(n, j) = sv(i, 4)
     arr(n + 1, j) = sv(i, 7)
     arr(n + 2, j) = sv(i, 10)
     n = n + 3
        If n > 8 Then
          n = 0
          j = j + 1
        End If
   End If
 Next i
Wb.Cells(45, k).Resize(9, 7) = arr
End With
End Sub
 

Bijlagen

  • IJ_Lossing 13 2019.xls
    48 KB · Weergaven: 28
  • voorbeeld bestand 1.xlsb
    27,9 KB · Weergaven: 33
Drie getallen maar.
Code:
arr([COLOR=#ff0000]11[/COLOR], 6)

Code:
If n > [COLOR=#ff0000]11[/COLOR] Then

Code:
Wb.Cells(45, k).Resize([COLOR=#ff0000]12[/COLOR], 7) = arr
 
Deze
Code:
.Range("a16:j38")
waarschijnlijk ook nog
 
Hans,

Nu wil ik alleen nog een wachtwoord op deze functie, is dat ook mogelijk.
Hoor graag van je.
 
Als voorbeeld.
Code:
Sub ImportNow()
Dim sv, r, i As Long, arr(8, 6), n As Long, j As Long, k As Long, Wb As Worksheet
Set Wb = ThisWorkbook.Sheets("blad1")
[COLOR=#ff0000]Wb.unprotect "jewachtwoordhiertussendedubbelequotes" [/COLOR]

With GetObject("E:\Excel\Lossing\IJ_lossing " & Application.InputBox("typ het weeknummer + spatie + jaartal", "openen", "bv. 12 2019", , , , , 2) & ".xls")
sv = .Sheets("loslijst ijmuiden").Range("a16:j38")
 For i = 1 To UBound(sv)
   r = Application.Match(CLng(sv(i, 2)), Wb.Rows(2), 0)
   If IsNumeric(r) Then
     If k = 0 Then k = r
     arr(n, j) = sv(i, 4)
     arr(n + 1, j) = sv(i, 7)
     arr(n + 2, j) = sv(i, 10)
     n = n + 3
        If n > 8 Then
          n = 0
          j = j + 1
        End If
   End If
 Next i
Wb.Cells(45, k).Resize(9, 7) = arr
[COLOR=#ff0000]Wb.protect[/COLOR][COLOR=#ff0000] "[/COLOR][COLOR=#FF0000]jewachtwoordhiertussendedubbelequotes" [/COLOR]
End With
End Sub
 
Bedankt voor de optie, maar deze optie beveiligd het wissen van de cellen die geimporteert zijn.
Ik bedoelde een beveiliging als men op de knop drukt om te importeren dat je dan een eerst een wachtwoord moet invoeren voordat deze gaat importeren.
excuus als het niet duidelijk was wat ik bedoelde.
 
Zo bedoel je.
Code:
Sub ImportNow()
Dim sv, r, i As Long, arr(8, 6), n As Long, j As Long, k As Long, Wb As Worksheet
[COLOR=#ff0000]if inputbox("wachtwoord invullen") = "jouwwachtwoord" then[/COLOR]
Set Wb = ThisWorkbook.Sheets("blad1")
With GetObject("E:\Excel\Lossing\IJ_lossing " & Application.InputBox("typ het weeknummer + spatie + jaartal", "openen", "bv. 12 2019", , , , , 2) & ".xls")
sv = .Sheets("loslijst ijmuiden").Range("a16:j38")
 For i = 1 To UBound(sv)
   r = Application.Match(CLng(sv(i, 2)), Wb.Rows(2), 0)
   If IsNumeric(r) Then
     If k = 0 Then k = r
     arr(n, j) = sv(i, 4)
     arr(n + 1, j) = sv(i, 7)
     arr(n + 2, j) = sv(i, 10)
     n = n + 3
        If n > 8 Then
          n = 0
          j = j + 1
        End If
   End If
 Next i
Wb.Cells(45, k).Resize(9, 7) = arr
End With
[COLOR=#ff0000]else
  msgbox "verkeerd wachtwoord"
end if[/COLOR]
End Sub
 
Ja top!!
Alleen jammer dat je geen puntjes of sterretjes ziet als je het wachtwoord invult.
 
Bij deze maar even in een bestand gegoten.
De code moet je nog even aanpassen naar de juiste bestandsmappen.
 

Bijlagen

  • voorbeeld bestand 1.xlsb
    31 KB · Weergaven: 30
Hans,
Weet jij toevallig ook hoe ik het werkblad automatisch kan vergrendelen als je het afsluit.
Als ik het via werkblad beveiligen doe moet ik elke keer als ik hem eraf haal weer de code opnieuw invoeren om hem te beveiligen.
Aangezien sommige mensen dit wel is vergeten kan diegene die hem opent en niet de code heeft hem toch bewerken.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan