Gå til innhold

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


Anbefalte innlegg

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

Lenke til kommentar
Videoannonse
Annonse

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

Lenke til kommentar

Opprett en konto eller logg inn for å kommentere

Du må være et medlem for å kunne skrive en kommentar

Opprett konto

Det er enkelt å melde seg inn for å starte en ny konto!

Start en konto

Logg inn

Har du allerede en konto? Logg inn her.

Logg inn nå
×
×
  • Opprett ny...