Hente data fra anden excelfil

Skulle nok kunne lade sig gøre via VBA - hvordan ser dine parametre ud?

Min opslagsparameter i fil1 celle a1 kunne være teksten sol-t-03 eller fsk-lev og mange andre, men med max 10 karakterer. I fil2 kolonne a vil denne tekst være i 5-20 forskellige rækker. Og disse 5-20 rækker vil jeg gerne have hentet over i fil1

OK - når der hentes fra fil2 - skal disse rækker indsættes fra række2 - eller skal de tilføjes efter de rækker, der måtte være i fil1?

De skal indsættes fra række 2. For i række 1 skal der stå nogle overskrifter til kolonnerne

Koden indsættes i Fil1 / Ark1:

Const fil2Sti = "C:\Documents and Settings\pb\Skrivebord\1005HenteFraAndenXLS\fil2.xls" 'TILPASSES
Dim ræk1, xls
Public Sub hentData()      '------> kaldes fra fil1 Alt+F8 - Afspil / eller opret knap
Rem slet gl. indhold i fil1
    Range("A2:Z65500").ClearContents
   
Rem test om parameter
    If Cells(1, 1) <> "" Then
      ræk1 = 2
      hentFraFil2 Cells(1, 1)
    End If
   
    lukfil2
End Sub
Private Sub hentFraFil2(param)
Dim celle2
    Set xls = CreateObject("Excel.Application")
    With xls
        .Workbooks.Open fil2Sti
        For ræk2 = 1 To 65500
            celle2 = .Cells(ræk2, 1)
Rem test om tom celle i kolonne A - hvis Ja - afslut
            If celle2 = "" Then
                lukfil2
                Exit Sub
            Else
                If celle2 = param Then
                    .Range(CStr(ræk2) + ":" + CStr(ræk2)).Select
                    .Selection.Copy
                    Cells(ræk1, 1).Select
                    With Selection
                        Paste
                    End With
                   
                    ræk1 = ræk1 + 1
                End If
            End If
        Next ræk2
    End With
End Sub
Private Sub lukfil2()
On Error Resume Next
    xls.Application.DisplayAlerts = False
   
    xls.ActiveWorkbook.Close
    xls.Application.Quit
    Set xls = Nothing
End Sub

Jeg når ikke at teste det idag, men hvor er det man definerer at den skal slå op med parameteren. Den kommer nemlig højst sandsynlig ikke til at ligge i celle a1 som jeg skal i det oprindelige spørgsmål. Lige nu ligger den i celle c5, men det kan ændre sig som jeg får bygget det endelige layout på regnearket. Og så ville det jo være rart hvis jeg selv kunne ændre det:-)

Jeg skyder på det er i denne her del
Rem test om parameter
    If Cells(1, 1) <> "" Then
      ræk1 = 2
      hentFraFil2 Cells(1, 1)
    End If

Korrekt...

Hej igen,

Det virker helt perfekt:-). Men kun hvis parameteren står i celle a1 i det ark hvor også data hentes ind. Hvordan ændrer jeg koden hvis den skal finde parameteren i et bestemt ark og bestemt celle.

Hej

OK - der skal en mindre ændring til - den vender jeg tilbage med lidt senere...

Nu kan du aktivere enhver celle i fil1/alle ark - herefter do. version 1 Alt+F8..

Rem Version 2
Rem =========
Const fil2Sti = "C:\Documents and Settings\pb\Skrivebord\1005HenteFraAndenXLS\fil2.xls" 'TILPASSES
Dim ræk1, xls
Public Sub hentData()      '------> kaldes fra fil1 Alt+F8 - Afspil / eller opret knap
Rem slet gl. indhold i fil1 / Ark1
    With ActiveWorkbook.Sheets(1)
        .Range("A2:Z65500").ClearContents
    End With
   
Rem hent parameter i den active celle (hvorsomhelst)
    If ActiveCell <> "" Then
      ræk1 = 2
      hentFraFil2 ActiveCell
    End If
   
    lukfil2
End Sub
Private Sub hentFraFil2(param)
Dim celle2
    Set xls = CreateObject("Excel.Application")
    With xls
        .Workbooks.Open fil2Sti
        For ræk2 = 1 To 65500
            celle2 = .Cells(ræk2, 1)
Rem test om tom celle i kolonne A - hvis Ja - afslut
            If celle2 = "" Then
                lukfil2
                Exit Sub
            Else
                If celle2 = param Then
                    .Range(CStr(ræk2) + ":" + CStr(ræk2)).Select
                    .Selection.Copy

Rem indsæt den fundne række på Ark1 (Fil1)
                    ActiveWorkbook.Sheets(1).Activate
                    Cells(ræk1, 1).Select
                    With Selection
                        Paste
                    End With
                                       
                    ræk1 = ræk1 + 1
                End If
            End If
        Next ræk2
    End With
End Sub
Private Sub lukfil2()
On Error Resume Next
    xls.Application.DisplayAlerts = False
   
    xls.ActiveWorkbook.Close
    xls.Application.Quit
    Set xls = Nothing
End Sub

Jeg tror du har misforstået det jeg gerne vil. Den kode du har lavet har jeg kopieret ind min fil i "Ark5". Parameteren står altid et fast sted, hvilket lige PT er "Ark1" celle C5. Så det er noget ala det nedenfor jeg tror der skal stå i stedet for ActiveCell. Men jeg ved det ikke, da dette er første gang jeg roder med VBA.

If Worksheets("Ark1").Cells(5, 3) <> "" Then
      ræk1 = 2
      hentFraFil2 Worksheets("Ark1").Cells(5, 3)
    End If

Jeg har afprøvet koden placeret i Ark 1
I version 2 kan param. hentes hvor som helst fra - sådan forstod jeg dit ønske - efter version 1.

I begge versioner lagres det hentede fra Fil2 netop i Ark1.

-
Men eller prøv dig lidt frem...

PS:
Rem indsæt den fundne række på Ark1 (Fil1)
                    ActiveWorkbook.Sheets(1).Activate

hvis du vil lagre det hentede fra fil2 i Ark5 - så er det ovenstående du skal ændre, som angivet i version 2
                    ActiveWorkbook.Sheets(5).Activate

Her er den endelige kode. Jeg fandt ud af at rette det sted den skal finde parameteren. Læg et svar.

Rem Version 2
Rem =========
Const fil2Sti = "S:\Okonomi\Projektoverblik\Projekt_timer\Projekt opfølgning\Bogforte_timer.xls" 'TILPASSES
Dim ræk1, xls
Public Sub hentData()      '------> kaldes fra fil1 Alt+F8 - Afspil / eller opret knap
Rem slet gl. indhold i fil1 / Ark1
    With ActiveWorkbook.Sheets(5)
        .Range("A2:Z65500").ClearContents
    End With
   
Rem hent parameter i den active celle (hvorsomhelst)
    If ActiveWorkbook.Sheets(1).Cells(5, 3) <> "" Then
      ræk1 = 2
      hentFraFil2 ActiveWorkbook.Sheets(1).Cells(5, 3)
    End If
   
    lukfil2
End Sub
Private Sub hentFraFil2(param)
Dim celle2
    Set xls = CreateObject("Excel.Application")
    With xls
        .Workbooks.Open fil2Sti
        For ræk2 = 1 To 65500
            celle2 = .Cells(ræk2, 1)
Rem test om tom celle i kolonne A - hvis Ja - afslut
            If celle2 = "" Then
                lukfil2
                Exit Sub
            Else
                If celle2 = param Then
                    .Range(CStr(ræk2) + ":" + CStr(ræk2)).Select
                    .Selection.Copy

Rem indsæt den fundne række på Ark1 (Fil1)
                    ActiveWorkbook.Sheets(5).Activate
                    Cells(ræk1, 1).Select
                    With Selection
                        Paste
                    End With
                                       
                    ræk1 = ræk1 + 1
                End If
            End If
        Next ræk2
    End With
End Sub
Private Sub lukfil2()
On Error Resume Next
    xls.Application.DisplayAlerts = False
   
    xls.ActiveWorkbook.Close
    xls.Application.Quit
    Set xls = Nothing
End Sub

Fint - du får et svar..