עזרה | פירוק טבלה לתאים

[arye zalaznik]

לצורך בניית קטלוג ספרים ברשותי טבלה עם מספר עמודות.
בכל עמודה הכותרת היא מספר המדף והתאים הם הספרים שבתוכה.
אני מעוניין ליצור גליון נוסף מבוסס על הטבלה הנ"ל ובה יופיע כל ספר ובמקביל יופיע מספר המדף.
יש דרך לעשות את זה?
מצרף גליון דוגמא
מדפים.xlsx
אני רוצה בעצם גליון חדש שבו יופיע לי כל ספר עם הכותרת של העמודה שלו, לדוגמא: ש"ע או"ח, 1.
הלכות בשר בחלב, 3.
וכן הלאה.
אודה לעזרתכם.

[אביי]

@arye-zalaznik הנה קוד vba שעושה את זה, לא הייתי אומר שהוא הכי יעיל בעולם, אבל למה שאתה צריך זה מצויין..

זה לוקח מכל עמודה את שורת הכותרת, ואז מדביק בגיליון "ספרים" את תוכן התאים בעמודה A ובעמודה B הוא רושם את המדף המתאים..

Sub CopyDataToBooksSheet()
    Dim shelvesSheet As Worksheet
    Dim booksSheet As Worksheet
    Dim sourceRange As Range
    Dim targetCell As Range
    Dim columnTitle As Range
    Dim sourceCell As Range
    Dim currentTitle As String
    
    Set shelvesSheet = ThisWorkbook.Sheets("מדפים") ' שם הגיליון המקורי
    Set booksSheet = ThisWorkbook.Sheets("ספרים") ' שם הגיליון שאליו יועתקו הנתונים מודרים מחדש
    
    Set sourceRange = shelvesSheet.Range("A:C") ' כאן יש להגדיר את טווח העמודות לטיפול בגיליון מדפים

    For Each columnTitle In sourceRange.Rows(1).Cells
        currentTitle = columnTitle.Value
        
        For Each sourceCell In columnTitle.Offset(1, 0).Resize(sourceRange.Rows.Count - 1, 1)
            If Not IsEmpty(sourceCell.Value) Then
                Set targetCell = booksSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)         
                targetCell.Value = sourceCell.Value
                targetCell.Offset(0, 1).Value = currentTitle
            End If
        Next sourceCell
    Next columnTitle
End Sub

[אביי]

@arye-zalaznik האם הסתדרת עם מה שהבאתי לך?