Свод заявочных листов...

[Slavatron1984]

Добрый день Старшие братья.
I need Help.

Получаем заказы с сети магазина по почте в екселе. Менеджеры зачастую либо теряют заказы, либо не вносят весь ассортимент, по итогу наша компания плотит за недопоставки. Меня нашли крайнего, нужно сверить заказы первичного вида с ассортиментом из нашей учетной системы. Кто сможет помочь из заявочных листов конвертировать в табличный вид.

Листы с начальной буквой L-*** сок код магазина. Количество листов с заказами может быть до 30 и более.

Буду очень признателен добрые люди.

Я екселем нормально , но макросы не мой конек.

Сеть магазинов через месяц два будет выбрасывать базой.

[Elixi]

Slavatron1984 ...

Sub SheetsToTable()
'   Для вашего файла.
'   Конвертация по вашему примеру данных из заявочных листов в табличный вид.
'   Запускайте при активной книге с данными.

    Dim Sht&, ShRowsCount&, DaRowsCount&, RwL&
    
    For Sht = 1 To Sheets.Count
        If Mid(Sheets(Sht).Name, 1, 2) = "L-" Then  ' Листы с начальной буквой L-
            ' оценка количества строк
            RwL = Sheets(Sht).Cells(Sheets(Sht).Rows.Count, 1).End(xlUp).Row
            ShRowsCount = ShRowsCount + RwL
        End If
    Next Sht
    
    ReDim Dannye(1 To 9, 1 To ShRowsCount)  '
    
     For Sht = 1 To Sheets.Count
        If Mid(Sheets(Sht).Name, 1, 2) = "L-" Then  ' Листы с начальной буквой L-
            ' данные в массив
            Call DannyeToArray(DaRowsCount, Dannye(), Sheets(Sht).Name)
        End If
    Next Sht

    ' массив данных в лист
    ReDim Preserve Dannye(1 To 9, 1 To DaRowsCount)
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = Format(Date, "YYYY-MM-DD") & "_" & Replace(Time, ":", "-")
    ActiveSheet.Cells(2, 1).Resize(UBound(Dannye, 2) - LBound(Dannye, 2) + 1, _
        UBound(Dannye, 1) - LBound(Dannye, 1) + 1) = WorksheetFunction.Transpose(Dannye)
    ActiveSheet.UsedRange.Columns.AutoFit
    ReDim Dannye(0, 0): Sht = 0: ShRowsCount = 0: DaRowsCount = 0: RwL = 0
End Sub

Sub DannyeToArray(DaRowsCount, Dannye(), SheetName$)
' данные в массив
    With Sheets(SheetName)
        If DaRowsCount = 0 Then
           DaRowsCount = 1
                Dannye(1, 1) = Split(.Cells(2, 6))(1)
                Dannye(2, 1) = .Cells(13, 1)
                Dannye(3, 1) = .Cells(13, 2)
                Dannye(4, 1) = .Cells(13, 10)
                Dannye(5, 1) = .Cells(9, 1)
                Dannye(6, 1) = .Cells(10, 1)
                Dannye(7, 1) = Split(.Cells(2, 6))(0) & " " _
                                & Split(.Cells(2, 6))(1)
                Dannye(8, 1) = .Cells(5, 4)
                Dannye(9, 1) = .Cells(6, 4)
        End If
        
        Dim RwL&, Rw&
        RwL = .Cells(.Rows.Count, 1).End(xlUp).Row
        
        For Rw = 14 To RwL
            If IsNumeric(.Cells(Rw, 1).Value) And _
                IsNumeric(.Cells(Rw, 10).Value) And _
                Len(Trim(.Cells(Rw, 1).Text)) > 0 And _
                Len(Trim(.Cells(Rw, 10).Text)) > 0 Then
                DaRowsCount = DaRowsCount + 1
                Dannye(1, DaRowsCount) = SheetName
                Dannye(2, DaRowsCount) = .Cells(Rw, 1)
                Dannye(3, DaRowsCount) = .Cells(Rw, 2)
                Dannye(4, DaRowsCount) = .Cells(Rw, 10)
                Dannye(5, DaRowsCount) = .Cells(9, 2)
                Dannye(6, DaRowsCount) = .Cells(10, 2)
                Dannye(7, DaRowsCount) = Split(.Cells(2, 6))(2) & " " _
                                & Split(.Cells(2, 6))(3)
                Dannye(8, DaRowsCount) = .Cells(5, 6)
                Dannye(9, DaRowsCount) = .Cells(6, 6)
            End If
        Next
    End With
End Sub

[Slavatron1984]

Elixi..
Дай Вам бог здоровья и успехов во Всем.

К утру пришли 40 заказов мы запустили код... И произошло ЧУДО... СПАСИБО...

[Elixi]

Slavatron1984
Я основываю решение на том, что увидел в вашем файле.
Например, код товара не содержит букв, а только числовые значения.
Если из этого есть исключения, предлагаемый код их проигнорирует.
Товар код которого содержит букбы не попадёт во сводную.