Avatar billede Ups50 Novice
26. marts 2020 - 10:01 Der er 3 kommentarer og
1 løsning

Kopier fra ark hvor betingelse er opfyldt

Hej alle

Jeg har en større fil med ca 100 faner, jeg har lavet en kode der viser et tal når en række betingelser er opfyldt

Så min udfordring er:
Når "L1" >=1 skal "F1:J1" kopieres og indsættes i et ark Der hedder "OB_LISTE2"

Jeg har prøvet med
Sub eks()

'
For Each xWorksheet In ActiveWorkbook.Worksheets
   
    Range("L1").Select
  If ActiveCell.Value >= 1 Then
    Range("F1:J1").Select
    Application.CutCopyMode = False
    Selection.Copy
   
    Sheets("OB_LISTE2").Select
  Cells(1, 1).End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Next xWorksheet
Else
End If
  Next xWorksheet
 
    Application.Run "'Lagerstyring - Viborg org. 1.1.xls'!eks"
End Sub

Men det er ihvertfald ikke vejen at gå
Måske I har en ide?

MVH
UPS50
Avatar billede store-morten Ekspert
26. marts 2020 - 10:47 #1
Prøv:
For Each xWorksheet In ActiveWorkbook.Worksheets
 
    xWorksheet.Select
   
If Range("L1").Value >= 1 Then
    Range("F1:J1").Copy
 
    Sheets("OB_LISTE2").Select
    Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
    ActiveSheet.Paste
Else

End If
  Next xWorksheet
 
Application.CutCopyMode = False
Avatar billede Ups50 Novice
26. marts 2020 - 14:57 #2
Hej Store Morten

Detvar det der skulle til! Det fungere præcist som ønsket
Mange tak for hjælpen

MVH
UPS50
Avatar billede store-morten Ekspert
26. marts 2020 - 15:25 #3
Velbekomme.
Prøv også denne, tror den er hurtigere:
Sheets("OB_LISTE2").Select

For Each xWorksheet In ActiveWorkbook.Worksheets
    If xWorksheet.Range("L1").Value >= 1 Then
        xWorksheet.Range("F1:J1").Copy _
        Destination:=Cells(Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0).Row, 1)
    Else
    End If
Next xWorksheet
 
Application.CutCopyMode = False
Avatar billede Ups50 Novice
31. marts 2020 - 10:05 #4
Hej Store-morten
SRY jeg først vender tilbage nu!
Du har ret, den sidste kode er markant hurtigere.

Endnu engang, mangetak for hjælpen

MVH
UPS50
Avatar billede 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. Der sættes "nofollow" på alle links.

Loading billede 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