I den andet fanebald vil jeg gerne samle data fra kolonne A,B og D, hvis PBD1 indgår i kollonne A. Nedenunder skal de samme data indsættes hvor henholdsvis PBD2 og PBD3 indgår i kolonne A. Sidenhen skal jeg også lave en graf for opdelingen.
Sub KopiAlle() Dim c As Range For Each c In Range("A2", Range("A2").End(xlDown)) if instr(1, c.value, "PBD1") > 0 then Range(c.Address, c.End(xlToRight)).Copy Destination:=Worksheets("Opsamlingsark").Range("A65536").End(xlUp).Offset(1, 0) end if Next End Sub
Sub KopiAlle() Dim c As Range For Each c In Range("A2", Range("A2").End(xlDown)) if instr(1, c.value, "PBD1") > 0 then Range(c.Address, c.offset(0,1)).Copy Destination:=Worksheets("Opsamlingsark").Range("A65536").End(xlUp).Offset(1, 0) Range(c.Offset(0,3), c.offset(0,3)).Copy Destination:=Worksheets("Opsamlingsark").Range("A65536").End(xlUp).Offset(0, 3) end if Next End Sub
Sub KopiAlle() Dim c As Range For Each c In Range("A2", Range("A2").End(xlDown)) if instr(1, c.value, "PBD1") > 0 then Range(c.Address, c.offset(0,1)).Copy Destination:=Worksheets("Opsamlingsark").Range("A65536").End(xlUp).Offset(1, 0) Range(c.Offset(0,3), c.offset(0,3)).Copy Destination:=Worksheets("Opsamlingsark").Range("A65536").End(xlUp).Offset(0, 2) end if Next End Sub
Er du sikker? Har testet her og koden virker efter hensigten Prøv at slette hvad du har på arket "Opsamlingsark" Og sikre dig at du har den nyeste version af min kode
Synes godt om
Ny brugerNybegynder
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.
