HHA Seniormester
14. januar 2021 - 20:16 Der er 5 kommentarer og
1 løsning

Hente data fra en anden fil

Hejsa,

Jeg vil har en makro der kan opdatere en fane ved at hente data fra et andet excel ark på computeren.
Det virker fint.
Men jeg vil gerne have den til at læse hvilken fil den skal åbne, ved at læse værdien i celle D15 (her har jeg en dropdown menu).
Jeg er i tvivl om, hvordan jeg skal skrive at den skal kigge i celle D15.

Jeg har denne linje nede i makroen:
    Set src = Workbooks.Open("J:\Test\prøve.xlsm", True, True)

Den virker fint, men den skal læse den værdi, altså den sti der står i celle D15
Nogen som kan hjælpe mig på vej?

Sub Opdaterfarver()

'On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    Worksheets("farver").Unprotect
    Dim src As Workbook
    Set ws1 = Sheets("farver")
    ws1.Range("B20:B" & Rows.Count).ClearContents
    ws1.Range("C20:C" & Rows.Count).ClearContents
    ws1.Range("D20:D" & Rows.Count).ClearContents
    ws1.Range("E20:E" & Rows.Count).ClearContents
    ws1.Range("F20:F" & Rows.Count).ClearContents
    ws1.Range("G20:G" & Rows.Count).ClearContents
    ws1.Range("H20:H" & Rows.Count).ClearContents
    ws1.Range("I20:I" & Rows.Count).ClearContents
    ws1.Range("J20:J" & Rows.Count).ClearContents
    ws1.Range("K20:K" & Rows.Count).ClearContents
    ws1.Range("K20:L" & Rows.Count).ClearContents
    ws1.Range("M20:M" & Rows.Count).ClearContents
    ws1.Cells.Borders.LineStyle = xlLineStyleNone
   
    ' OPEN THE SOURCE EXCEL WORKBOOK IN "READ ONLY MODE".
 

' HER HER HER

    Set src = Workbooks.Open("J:\Test\prøve.xlsm", True, True)
   



    ' GET THE TOTAL ROWS FROM THE SOURCE WORKBOOK.
    Dim iTotalRows As Integer
    iTotalRows = src.Sheets("Kalk").Range("D1:D" & Cells(Rows.Count, "D").End(xlUp).row).Rows.Count
 
    ' COPY DATA FROM SOURCE (CLOSE WORKGROUP) TO THE DESTINATION WORKBOOK.
    Dim iCnt As Integer        ' COUNTER.
    For iCnt = 20 To iTotalRows
    ws1.Cells(iCnt, "A").Value = "Nej"
       
       
    With ws1.Cells(iCnt, "A").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=$A$18:$A$19"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
   
       
        ws1.Cells(iCnt, "B").Value = 1
        ws1.Cells(iCnt, "C").Value = src.Worksheets("Kalk").Cells(iCnt, "D").Value
        ws1.Cells(iCnt, "C").BorderAround xlContinuous
           
            If src.Worksheets("Kalk").Cells(iCnt, "B") = "JA" Then ' Laver overskrifter gule, hvis kilden siger at det er en overskrift
                ws1.Cells(iCnt, "C").Interior.ColorIndex = 6
                ws1.Cells(iCnt, "B").Value = ""
            ElseIf ws1.Cells(iCnt, "C") = "" Then
                ws1.Cells(iCnt, "B") = ""
                ws1.Cells(iCnt, "C").Interior.ColorIndex = 2
            Else
                ws1.Cells(iCnt, "C").Interior.ColorIndex = 2
            End If
          ' If src.Worksheets("Kalk").Cells(iCnt, "B") = "NEJ" Then ' Laver celler hvid, hvis kilden siger at det ikke er en overskrift
         
                     
        ws1.Cells(iCnt, "D").Value = src.Worksheets("Kalk").Cells(iCnt, "E").Value
        ws1.Cells(iCnt, "D").BorderAround xlContinuous
        ws1.Cells(iCnt, "E").Value = src.Worksheets("Kalk").Cells(iCnt, "F").Value
        ws1.Cells(iCnt, "E").BorderAround xlContinuous
        ws1.Cells(iCnt, "F").Value = src.Worksheets("Kalk").Cells(iCnt, "I").Value
        ws1.Cells(iCnt, "F").BorderAround xlContinuous
        ws1.Cells(iCnt, "G").Value = src.Worksheets("Kalk").Cells(iCnt, "J").Value
        ws1.Cells(iCnt, "G").BorderAround xlContinuous
        ws1.Cells(iCnt, "H").Value = src.Worksheets("Kalk").Cells(iCnt, "K").Value
        ws1.Cells(iCnt, "H").BorderAround xlContinuous
        ws1.Cells(iCnt, "I").Value = src.Worksheets("Kalk").Cells(iCnt, "L").Value
        ws1.Cells(iCnt, "I").BorderAround xlContinuous
        ws1.Cells(iCnt, "J").Value = src.Worksheets("Kalk").Cells(iCnt, "A").Value
        ws1.Cells(iCnt, "J").BorderAround xlContinuous
        ws1.Cells(iCnt, "K").Value = src.Worksheets("Kalk").Cells(iCnt, "C").Value
        ws1.Cells(iCnt, "K").BorderAround xlContinuous
        ws1.Cells(iCnt, "L").Value = src.Worksheets("Kalk").Cells(iCnt, "M").Value
        ws1.Cells(iCnt, "L").BorderAround xlContinuous
        ws1.Cells(iCnt, "M").Value = src.Worksheets("Kalk").Cells(iCnt, "U").Value
        ws1.Cells(iCnt, "M").BorderAround xlContinuous
        ws1.Cells(iCnt, "A").BorderAround xlContinuous
        ws1.Cells(iCnt, "B").BorderAround xlContinuous
    Next iCnt
   
    ' CLOSE THE SOURCE FILE.
    src.Close False            ' FALSE - DON'T SAVE THE SOURCE FILE.
    Set src = Nothing
   
    Application.ScreenUpdating = True
    Worksheets("farver").Protect
    EnableSelection = xlNoRestrictions
   
ErrHandler:
   
    'src.Close False      ' FALSE - DON'T SAVE THE SOURCE FILE.
    Set src = Nothing
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Worksheets("farver").Protect
    EnableSelection = xlNoRestrictions
   
   
End Sub
kim1a Ekspert
14. januar 2021 - 21:45 #1
Set src = Workbooks.Open("J:\Test\prøve.xlsm", True, True)

Du skal ændre "J:\Test\prøve.xlsm" til noget andet. Du kan måske gøre det nemt ved at lave en ny variabel som tager værdien fra din celle ind.

Sæt
Dim strFil as string
strFil = range("D15").value

ovenstående kræver dog at du er på den korrekte fane - så det kan være en fordel at skrive
strFil = sheets("navn").range("D15").value
HHA Seniormester
16. januar 2021 - 18:22 #2
Hej kim1a,

Det er lige nøjagtigt det du foreslår, som jeg ikke har evnerne til at kode.

Hvis jeg fjerner Set src = Workbooks.Open("J:\Test\prøve.xlsm", True, True) og sætter følgende ind:

    Sæt
    Dim strFil As String
    strFil = Range("D15").Value

Skriver den Compile error:
Sub or Function not defined.

Jeg har en dropdown menu i celle D15, hvor der er stier der er i orden, jeg har testet dem ved at indsætte dem direkte den gamle kode.
kim1a Ekspert
17. januar 2021 - 08:47 #3
Du skal jo ikke fjerne det hele - kun selve stien filen står i.

Sæt dette ind før din kode:
Dim strFil As String
    strFil = Range("D15").Value

Slet så din :
Set src = Workbooks.Open("J:\Test\prøve.xlsm", True, True)
og skriv i stedet dette:
strFil = sheets("navn").range("D15").value
HUSK at ændre "navn" til "din fane hvor D15 står navn"
HHA Seniormester
17. januar 2021 - 19:10 #4
Hej kima1,

Det funker ikke rigtigt.
Får en run-time error 91
Object variable or with block variable not set.


Så peger den på:

  iTotalRows = src.Sheets("Kalk").Range("D1:D" & Cells(Rows.Count, "D").End(xlUp).Row).Rows.Count

Denne linje har jeg ikke ændret på.
Så den virker fint med det direkte link til "source kilden" dog ikke med det vi nu forsøger.

Hvad kan det ligge i?


Her er et klip af linjerne omkring  det ændrede og der hvor den melder fejl.


    Dim strFil As String
   
    strFil = Range("M15").Value
   
    strFil = Sheets("Standardpriser").Range("M15").Value
   
    ' GET THE TOTAL ROWS FROM THE SOURCE WORKBOOK.
    Dim iTotalRows As Integer
    iTotalRows = src.Sheets("Kalk").Range("D1:D" & Cells(Rows.Count, "D").End(xlUp).Row).Rows.Count
 
    ' COPY DATA FROM SOURCE (CLOSE WORKGROUP) TO THE DESTINATION WORKBOOK.
    Dim iCnt As Integer        ' COUNTER.
    For iCnt = 20 To iTotalRows
    ws1.Cells(iCnt, "A").Value = "Nej"
kim1a Ekspert
18. januar 2021 - 08:02 #5
Ej, undskyld det er mig der er en klovn.

Sæt dette ind før din kode:
Dim strFil As String
    strFil = sheets("navn").range("D15").value 'HUSK at ændre "navn" til "din fane hvor D15 står navn"

Slet så din :
Set src = Workbooks.Open("J:\Test\prøve.xlsm", True, True)
og skriv i stedet dette:
Set src = Workbooks.Open(strFil, True, True)

Jeg beklager.
HHA Seniormester
18. januar 2021 - 09:45 #6
Hej kim1a,

Du skal da ikke beklage, der er da mig der skal.
Det er da mig der beklager, at jeg ikke kan finde ud af det :)

Nu virker det, tusind tak!
Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links

Opret Preview

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester





Premium
Norda flytter 267 it-stillinger til Indien: 125 danske it-ansatte mister jobbet
Nordea og Finansforbundet har nu indgået en endelig aftale om, hvor mange it-ansatte der bliver nedlagt i Danmark. Det samlede antal er dermed reduceret med 100 i forhold til det oprindelige oplæg.
Computerworld
Trump bønfalder Helle Thorning: Giv mig min Facebook-konto tilbage
Facebooks tilsynsråd, der har Helle Thorning-Schmidt i spidsen, har modtaget en erklæring fra Donald Trump, som ønsker at få genoprettet adgangen til sin Facebook og Instagram-konto.
CIO
Der findes ikke noget vigtigere for din virksomhedskultur end psychological safety
Klumme: Forskningen er entydig: Vidensarbejde er mere effektiv, når du tør stille spørgsmål, rejse kritik og indrømme fejl helt uden frygt for at blive straffet eller gjort til grin. Hvis du ikke har fokus på denne del af din virksomhedskultur, så lever din virksomhed og dine medarbejdere ikke op til deres fulde potentiale.
Job & Karriere
IBM Danmark trækker tilbud om frivillige fratrædelser tilbage for stort antal ansatte: "IBM har taget røven på sine ansatte"
Som led i IBM Danmarks store fyringsrunde fik 130 ansatte grønt lys til at forlade selskabet på en frivillig fratrædelsesordning. Men nu har IBM Danmark trukket det oprindelige tilbud tilbage for størstedelen af de ansatte.
White paper
Kunsten at navigere i en tilpasningsøkonomi
Evnen til at tilpasse sig en verden i konstant forandring bliver afgørende for virksomhedens mulighed for at vækste i fremtiden. Ét af de finansielle håndtag du kan skrue på, er en hel eller delvis outsourcing af it-driften. I e-bogen ”Kunsten at navigere i en tilpasningsøkonomi” får du viden om, hvordan din virksomhed kan bruge tilpasningsøkonomi til at håndtere fremtidens krav til it. Vi spørger blandt andet: - Kan din virksomhed skalere og tilpasse sin digitale kapacitet og økonomi? - Har dine kunder tillid til, at du har de skarpeste it-løsninger? - Ville I kunne styrke forretningen ved at give jeres it mere fokus? - Kan I få øget funktionalitet til samme pris? Vi fokuserer på risiko, økonomi, fokus og valg af it-partner, som er fire opmærksomhedspunkter du skal have styr på for at lykkes med at tilpasse virksomheden til at modstå forandringerne i verden.