Met knop allerlei gegevens in nieuw bestand genereren

[Pienjo]

'Lo,

Momenteel ben ik bezig met het maken van een excelsheetje waarop de planning van personen kan worden opgebouwd. Er is al een sheet actief die de planning van machines en producten organiseerd. Nu wil ik uit deze sheet de nodige informatie gebruiken om mbv een knop de planning van personen uit te zetten.

bv in de planningstabel vind ik het volgende terug:
machine 1 --> product A --> 5 personen
machine 2 --> product B --> 12 personen
....

In een nieuw bestand zou dan het volgende moeten gegenereerd worden: (; celseperator)
(rijX+0) Machine 1;(wit);(wit);(wit);(wit);(wit);(zwart);(zwart);(zwart);(zwart);(zwart);(zwart);(zwart);(zwart)
(rijX+1) Machine 2;(wit);(wit);(wit);(wit);(wit);(wit);(wit);(wit);(wit);(wit);(wit);(zwart)

Ik hoop dat het een beetje duidelijk is. Momenteel werk ik aan een voorbeeldsheetje om het nog wat te verduidelijken...

 

[Demeter]

Waarom wil je deze planning in een nieuw bestand hebben?
Is handiger als in het zelfde werkblad wordt gehouden

Zijn er altijd 12 machines?
Ivm dynamiek van zoekfuncties in je code.

 

[Pienjo]

Ze zou in een nieuw bestand moeten komen omdat dit dan verder kan verwerkt worden door andere personen parallel met dit andere bestand.

Het aantal machines ligt vast, maar die dynamiek zal ik eventueel zelf wel kunnen verzorgen zeker? niet?

Stijn

 

[Wigi]

Stijn

Sub nieuwetabel()
    Dim wkb As Workbook, c As Range, wksSource As Worksheet
    Set wksSource = ActiveSheet
    Set wkb = Workbooks.Add
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With wkb
        wksSource.Range("A4:A" & wksSource.Range("A" & Rows.Count).End(xlUp).Row).Copy wkb.Sheets(1).Range("A1")
        wksSource.Range("D4:D" & wksSource.Range("A" & Rows.Count).End(xlUp).Row).Copy wkb.Sheets(1).Range("B1")
        
        With .Sheets(1)
            For Each c In .Columns(1).SpecialCells(xlCellTypeConstants)
                If c.Offset(, 1) < 20 Then c.Offset(, 2 + c.Offset(, 1)).Resize(, 20 - c.Offset(, 1)).Interior.ColorIndex = 1
            Next
        End With
        .Columns(1).SpecialCells(xlCellTypeConstants).Borders.LineStyle = xlContinuous
        .SaveAs "C:/Tabel.xls"
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Wigi

 

[Demeter]

Voor in het zelfde blad.
kijk eens naar de attachment.
let ook op de vert.zoeken functie in kolom b .

Code, voor de liefhebber:

Sub kleuren()
Dim c As Range

Application.ScreenUpdating = False

Sheets("Planning personen").Range("C5:V16").Interior.ColorIndex = 56

For Each c In Sheets("Planning personen").Range("B5:B16")
    If c <> "" And c < 21 Then
        For x = 3 To c.Value + 2
            Cells(c.Row, x).Interior.ColorIndex = 0
        Next
    End If
Next

Application.ScreenUpdating = True

End Sub