[Løst] Søk fllere sheets i Excel, og kopier resultat i et annet sheet.

[Errae]

Hei.

 

Jeg holder på å lage et "enkelt" regnskap for en klubb, og trenger en funksjon for å søke igjennom hele excel-arket.

 

Funksjonen skal søke igjennom alle ark, utenom aktivt ark, etter et bestemt ord: "bilag-utgift"

Dette ordet står i kolonne I.

 

Deretter skal resultatet limes inn i aktivt ark.

 

Når macroen kjøres skal allerede resultat (fra forrige kjøring) som ligger i aktivt ark slettes fra rad 2 og nedover. Nytt resultat skal limes inn fra rad 2 igjen.

 

Noen som vet om noe som dette eksisterer?

Jeg har funnet en macro, men den søker kun igjennom et ark...

 

   Sub SearchForString()

       Dim LSearchRow As Integer
       Dim LCopyToRow As Integer

       On Error GoTo Err_Execute

       'Start search in row 4
       LSearchRow = 11

       'Start copying data to row 2 in Sheet2 (row counter variable)
       LCopyToRow = 4

       While Len(Range("A" & CStr(LSearchRow)).Value) > 0

           'If value in column I = "Mail Box", copy entire row to Sheet2
           If Range("I" & CStr(LSearchRow)).Value = "Bilag-Utgift" Then

               'Select row in Sheet1 to copy
               Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
               Selection.Copy

               'Paste row into Sheet2 in next row
               Sheets("Samling Bilag").Select
               Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
               ActiveSheet.Paste

               'Move counter to next row
               LCopyToRow = LCopyToRow + 1

               'Go back to Sheet1 to continue searching
               Sheets("Sheet1").Select

           End If

           LSearchRow = LSearchRow + 1

       Wend

       'Position on cell A3
       Application.CutCopyMode = False
       Range("A3").Select

       MsgBox "All matching data has been copied."

       Exit Sub

Err_Execute:
       MsgBox "An error occurred."

   End Sub

 

Setter stor pris på hjelp, da det sparer meg for masse arbeid.

 

Takk

[Harald Staff]

Hei

 

Dette er løselig. Men først, du kopierer hele raden cirka her:

 

Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select

Selection.Copy

 

Kan du være mer spesifikk på hvilket område du skal kopiere?

Også, er det bare verdiene som skal overføres eller også formler, formatering, farger etc etc ?

 

Beste hilsen Harald

[Errae]

Jeg fant ut at det var lettere å gjøre det andre veien.

Lage en samleliste, deretter kopiere tabellene. "Paste special" -> "Paste as Link"

Deretter filtrere, og bruke autosum med funksjon 9. (=

 

 

Thanks