Lopslag som også kopiere formatering

Der er ikke umiddelbart en formel der kan kopiere format (jeg har i hvert fald aldrig set det...), men måske kan dit behov dækkes af betinget formattering? Alternativt kan man lave en makro/noget VBA der sætter formatteringen.

Kan du sætte nogle regler for hvordan der skal formatteres? (Hvis ikke reglerne er afhængige af hvordan formatteringen er i det ark der slås op i, er det simplest).

Det er ikke muligt at lave betinget formatering da der ikke er nogen egentlige kriterier for hvordan formateringen er.
Det er kopieret fra en andet program, så nogle af linierne er med fed, mens andre er med indryk.

Så den sidste udvej må være VBA, men jeg har meget lidt erfaring med dette!

Bare lige at forstå det præcist, så har du ark 1 med de 8000 rækker og der er et id i kolonne A. I ark 2-9 har du så fordelt de 8000 id'er ud i de forskellige ark, og så bruger du LOPSLAG til at indlæse værdierne fra de øvrige kolonner fra ark 1 til de andre ark. Er det korrekt forstået?

Hvis man brugte VBA kunne man så lige så godt bare kopiere hele rækken fra ark1 til det relevante andet ark? Ville det give dig samme resultat, eller laver du anden manipulation undervejs?

Ja det er korrekt, og ja man kan i princippet ligeså godt kopiere til hver ark. Det variere hvor lang listen er men f.eks. kunne det være at de første 30 linier skal på ark 2, de næste 43 linier skal på ark 3 osv....

Linierne er ikke blandet og kommer altid i rækkefølge således at det første skal til ark 2, dernæst til ark 3 og så frem ledes. Dog kan det være et forskelligt antal linier fra gang til gang der skal kopieres, derfor lopslag.

Så ville det fx være smart for dig at lave et ark, hvor du for ark 2, 3... 9 kunne angive start og slut række, og så trykke på en knap for at kunne få kopieret de angivne rækker til de 8 ark fra ark 1?

Ja det ville være ok.

Dog ville det hjælpe endnu mere hvis den selv kunne finde start og slut ud fra kolonne B, da dette altid er det samme tal den skal hente i denne kolonne!

Eks.
Ark 2 skal lede efter nr. 2
Ark 3 skal lede efter nr. 3
osv.

Det kan selvf. også lade sig gøre. Et par uddybende spm.
- Hvor mange kolonner er der data i?
- Og er det rigtigt at antage at der er overskrifter i række 1 og data starter i række 2?
- Arkene hedder præcist: Ark1, Ark2, Ark3, ... , Ark9?

ok Listen kommer vist maks til at fylde 2500 linier.

Overskriften er i række 1-4
Dataerne starter i række 5
Tallene som arkene skal hente fra er i kolonne K og
Dataerne som skal kopieres til de andre ark er i kolonne L til Q

Nu blev jeg lige forvirret - de tal der står i kolonne K - er det dem der afgør hvilket ark data skal kopieres over i? Dvs. dem du tidligere skrev var i kolonne B?

Og skal kolonnerne L-Q fra ark 1 kopieres til kolonnne L-Q i ark2-9  eller A-F?

Ja beklager, jeg havde ikke lige arket på arbejde, så det første jeg skrev var ud fra hukommelsen.

Kolonne B=K, jeg huskede bare forkert.

Og kolonne L-Q skal kopieres til arkene i kolonne A-F

Ok - jeg tror jeg har en løsning til dig. Den skal muligvis lige justeres hvis der er detaljer jeg har misforstået.

Læg koden efter linjen med stjerne ind i et modul i VBA-editoren. For at oprette et modul, højreklik på "Modules" og vælg Insert/Indsæt.

Så vil der være en makro med navn KopierData, som du kan køre.
Tag lige en kopi af dit originale ark først inden du prøvet det af, så vi ikke ødelægger noget og ikke kan genskabe det.

***********************************
Option Explicit

Const MASTERSHEET_NAME = "Ark1"

Public Sub KopierData()
    Dim targetSheetNo As Integer
   
    Dim masterSheet As Worksheet
    Dim targetSheet As Worksheet
   
    Dim copyRange As Range
   
    Set masterSheet = Worksheets(MASTERSHEET_NAME)
   
    For targetSheetNo = 2 To 9
        Set targetSheet = Worksheets("Ark" & targetSheetNo)
        targetSheet.Range("A5:Z20000").Delete
       
        Set copyRange = GetArkData(targetSheetNo)
       
        If Not copyRange Is Nothing Then
            copyRange.Copy
            targetSheet.Range("A5").PasteSpecial
            targetSheet.Range("A5:A20000").Delete xlShiftToLeft
        End If
    Next
   
End Sub

Public Function GetArkData(arkNo As Integer) As Range

        Dim totalRange As Range
        Dim header As Range
        Dim wsMaster As Worksheet
        Set wsMaster = Worksheets(MASTERSHEET_NAME)

        wsMaster.AutoFilterMode = False

        Set header = wsMaster.Range("K4:Q4")

        header.AutoFilter
        header.AutoFilter field:=1, Criteria1:="=" & arkNo
        Set totalRange = wsMaster.AutoFilter.Range

        On Error Resume Next
        Set GetArkData = totalRange.Offset(1, 0).Resize(totalRange.Rows.Count - 1).SpecialCells(xlCellTypeVisible)

End Function

hmmm, navnene på de forskellige ark er ikke ark 2, ark 3 osv. kan det være derfor det ikke virker?

Den strander på "Set targetSheet = Worksheets("Ark" & targetSheetNo)"

ps. det er et eng. excel gør det nogen forskel?

Ja, det er derfor - jeg spurgte jo netop om arkene hed Ark2, osv.
Du må lige skrive præcist hvad alle arkene hedder, så må vi rette op på det.

Engelsk version gør ingen forskel, og jeg kører i øvrigt selv engelsk excel.

ok beklager.

arkene hedder følgende:
429, 493, 715, 747, 772, 773, 835, 894

Og arket med listen hedder Data.

Jeg beklager besværet, jeg troede ikke VBA søgte på deres navne, da den jo stadig viser dem som sheet 1, sheet 2, osv.

Det er rigtigt at man kan benytte Sheet1, Sheet2 etc internt i VBA, men det var lettere at slå op hvis arkene visuelt hed ark1, ark2 osv. Men bare for at være helt skarp så:

Sheet1 = Data
Sheet2 = 429, svarer til værdien 2 i kolonne K i Data-ark
Sheet3 = 493, svarer til værdien 3 i kolonne K i Data-ark
Sheet4 = 715, svarer til værdien 4 i kolonne K i Data-ark
Sheet5 = 747, svarer til værdien 5 i kolonne K i Data-ark
Sheet6 = 772, svarer til værdien 6 i kolonne K i Data-ark
Sheet7 = 773, svarer til værdien 7 i kolonne K i Data-ark
Sheet8 = 835, svarer til værdien 8 i kolonne K i Data-ark
Sheet9 = 984, svarer til værdien 9 i kolonne K i Data-ark

Er det korrekt?

Sheet1 = forside
Sheet2 = 429, svarer til værdien 2 i kolonne K i Data-ark
Sheet3 = 493, svarer til værdien 3 i kolonne K i Data-ark
Sheet4 = 715, svarer til værdien 4 i kolonne K i Data-ark
Sheet5 = 747, svarer til værdien 5 i kolonne K i Data-ark
Sheet6 = 772, svarer til værdien 6 i kolonne K i Data-ark
Sheet7 = 773, svarer til værdien 7 i kolonne K i Data-ark
Sheet8 = 835, svarer til værdien 8 i kolonne K i Data-ark
Sheet9 = 894, svarer til værdien 9 i kolonne K i Data-ark
Sheet10 = data

Med mindre du kan lave makroen så den henter navnene på arkene i kolonne K.
pt. erstatter jeg nemlig 429 med værdien 2, 493 med værdien 3, osv.

altså kunne det være således:

Sheet1 = forside
Sheet2 = 429, svarer til værdien 429 i kolonne K i Data-ark
Sheet3 = 493, svarer til værdien 493 i kolonne K i Data-ark
Sheet4 = 715, svarer til værdien 715 i kolonne K i Data-ark
Sheet5 = 747, svarer til værdien 747 i kolonne K i Data-ark
Sheet6 = 772, svarer til værdien 772 i kolonne K i Data-ark
Sheet7 = 773, svarer til værdien 773 i kolonne K i Data-ark
Sheet8 = 835, svarer til værdien 835 i kolonne K i Data-ark
Sheet9 = 894, svarer til værdien 894 i kolonne K i Data-ark
Sheet10 = data

Altså dit nederste forslag ville være det letteste (og mest elegante), så hvis det også er lettest for dig, synes jeg vi skal gå efter den nederste løsning. Hvad siger du?

Helt klart, det vil spare mig for en del arbejde"

Ok - prøv dette. Husk at tage backup :)

*********************************

Option Explicit

Const MASTERSHEET_NAME = "data"

Public Sub KopierData()
    Dim targetSheetNo As Integer
   
    Dim masterSheet As Worksheet
    Dim targetSheet As Worksheet
   
    Dim sheetNames As Variant
   
    Dim copyRange As Range
   
    sheetNames = Array(429, 493, 715, 747, 772, 773, 835, 894)
    Set masterSheet = Worksheets(MASTERSHEET_NAME)
   
    For targetSheetNo = LBound(sheetNames) To UBound(sheetNames)
        Set targetSheet = Worksheets(CStr(sheetNames(targetSheetNo)))
        targetSheet.Range("A5:Z20000").Delete
       
        Set copyRange = GetArkData(sheetNames(targetSheetNo))
       
        If Not copyRange Is Nothing Then
            copyRange.Copy
            targetSheet.Range("A5").PasteSpecial
            targetSheet.Range("A5:A20000").Delete xlShiftToLeft
        End If
    Next
   
End Sub

Public Function GetArkData(ByVal arkNo As Integer) As Range

        Dim totalRange As Range
        Dim header As Range
        Dim wsMaster As Worksheet
        Set wsMaster = Worksheets(MASTERSHEET_NAME)

        wsMaster.AutoFilterMode = False

        Set header = wsMaster.Range("K4:Q4")

        header.AutoFilter
        header.AutoFilter field:=1, Criteria1:="=" & arkNo
        Set totalRange = wsMaster.AutoFilter.Range

        On Error Resume Next
        Set GetArkData = totalRange.Offset(1, 0).Resize(totalRange.Rows.Count - 1).SpecialCells(xlCellTypeVisible)

End Function

Kanon så virker det.

I arket data skjuler den de rækker den har kopieret over til de andre ark! kan den vise disse igen?

Det gik lige op for mig at det er et filter.
Kan den slutte Macro´en af med at vise alle tallene i filteret igen?

Indsæt denne linje sidst i KopierData-sub'en, dvs. mellem "Next" og "End Sub" linjerne.

masterSheet.AutoFilterMode = False

Jeg har noget betinget formatering som den ikke kopiere med over, kan dette rettes?

og jeg skylder dig vist lidt flere point for denne her!

mange tak!

hmm... den burde umiddelbart kopiere det hele over - kan der være noget med at den betingede formattering refererer nogle kolonner der ikke kopieres med - eller at der er noget med at vi flytter fra kolonne L-Q til A-F, og at betingelserne stadig refererer til L-Q eller sådan noget?

Og skidt med antallet af point - nogle gange får man mange point for småting, andre gange få point for noget der ender med at tage lidt tid. Det vigtigste er at få hjulpet folk :o)

Jeg lægger dette som svar - men lad os bare se om vi kan få skovlen under dit formatteringsproblem og fortsætte tråden - jeg går dog snart af for i dag, så det må evt. blive i morgen...

Nå ja - jeg fik ikke lagt foregående som svar, så det kommer lige her...

Ahhhh, det var fordi jeg havde låst formateringen til kolonne L-Q

Tak for hjælpen, smid et svar så får du point!