[Ptaszko]

Witam.
Bardzo proszę o pomoc w napisaniu makra do zliczania w tabeli wartości z arkuszy z wierszy.
Założenia: (załączony plik pomocniczy).
1. Posiadam skoroszyt - Karta płac, zawierający wiele arkuszy (może być ich od 1 do nawet 200).
2. Każdy arkusz jest nazwany Imieniem i nazwiskiem pracownika.
3. W każdym arkuszu znajduje się 14 kolumn, ale może ich być mniej w zależności od zatrudnienia danego pracownika. Zawsze w ostatniej kolumnie znajduje się zsumowana wartość z danego wiersza.
4. Każdy arkusz zawiera wiersze o nazwach zawartych w pierwszej kolumnie, których położenie moze być różne w zależności jakie składniki wynagrodzenia przysługują danemu pracownikowi.
Makro miałoby:
1. Utworzyć nowy skoroszyt o nazwie np. tabela
2 Utworzyć tabelkę z nazwiskami pracowników (imię i nazwisko to nazwa danego arkusza)
3. W tabeli przy każdym pracowniku w kolumnie o nazwie danego składnika zliczyć wartości z wszystkich miesięcy.
4. składniki wynagrodzenia to
- dopł. za pracę w nocy
- godziny nadliczbowe
- wyrówn. godziny nadliczbowe
- wyrówn. godzin nocnych
5. Jeśli u danego pracownika nie wystąpią te składniki to ma wpisac wartość 0,00
Będę bardzo wdzięczny za takie makro bo bardzo mi ułatwi pracę.
Pozdrawiam
Grzegorz
Poniżej plik
[/u]

---

Kart płacowe 08-2021-07-2021 przykład.xlsx

Pobierz Plik ściągnięto 27 raz(y) 38.9 KB

[Maciej Gonet]

Propozycja makra:

Kod:

Sub Generator_Tabeli()     Dim Nagl(1 To 6) As String     Application.ScreenUpdating = False     Application.DisplayAlerts = False     Workbooks.Add(xlWBATWorksheet).SaveAs Filename:= _         "Tabela_płace.xlsx", FileFormat:= _         xlOpenXMLWorkbook, CreateBackup:=False     Application.DisplayAlerts = True     ActiveSheet.Name = "Tabela"     Nagl(1) = "Imię i Nazwisko"     Nagl(2) = "dopł. za pracę w nocy"     Nagl(3) = "godziny nadliczbowe"     Nagl(4) = "wyrówn. godziny nadliczbowe"     Nagl(5) = "wyrówn. godzin nocnych"     Nagl(6) = "Wartość zmiennych"     Range("A1:F1").Value = Nagl     Range("A1:F1").Font.Bold = True         Dim ws, nr As Long, kol As Long, w As Long     With ThisWorkbook         nr = 1   ' numer wiersza w tabeli wynikowej         For Each ws In .Worksheets             If ws.Name <> "Tabela" Then                 nr = nr + 1                 Cells(nr, "A") = ws.Name                 On Error Resume Next                 For kol = 2 To 5                     ' w = nr wiersza na karcie płac                     w = ws.Columns(1).Find(Nagl(kol)).Row                     If Err = 0 Then                         Cells(nr, kol).Value = ws.Cells(w, ws.Columns.Count).End(xlToLeft).Value                     Else                         Cells(nr, kol).Value = 0                         Err.Clear                     End If                 Next kol                 On Error GoTo 0                 Cells(nr, 6).FormulaR1C1 = "=SUM(RC[-4]:RC[-1])"             End If         Next ws     End With     With Range("A1").CurrentRegion         .Borders.LineStyle = xlContinuous         .Offset(1, 1).Resize(nr - 1, 5).NumberFormatLocal = _               "# ##0,00_ ;[Czerwony]-# ##0,00\ "     End With     ActiveWorkbook.Save     Application.ScreenUpdating = True End Sub

Utworzony plik ma nazwę "Tabela_płace.xlsx". Jest zapisywany w bieżącym katalogu.

---

Kart płacowe 08-2021-07-2021 przykład.xlsm

Pobierz Plik ściągnięto 50 raz(y) 49.77 KB

[Ptaszko]

Serdecznie dziękuję za pomoc. Makro działa.

[Ptaszko]

Maciej Gonet, Bardzo serdecznie dziękuję za pomoc. Makro działa i pomoże mi w pracy. Pozdrawiam Grzegorz