Function DopasujOdpowiednik(DinBG As String)
    Select Case DinBG
        Case "BA"
            DopasujOdpowiednik = "BG200"
        Case "BB"
            DopasujOdpowiednik = "BG200"
        Case "BC"
            DopasujOdpowiednik = "BG200"
        Case "BD"
            DopasujOdpowiednik = "BG200"
        Case "BE"
            DopasujOdpowiednik = "BG200"
        Case "BF"
            DopasujOdpowiednik = "BG200"
        Case "BG"
            DopasujOdpowiednik = "BG200"
        Case "BH"
            DopasujOdpowiednik = "BG200"
        Case "BJ"
            DopasujOdpowiednik = "BG200"
        Case "BX"
            DopasujOdpowiednik = "BG200"
        Case "CA"
            DopasujOdpowiednik = "BG600"
        Case "CB"
            DopasujOdpowiednik = "BG660"
        Case "CC"
            DopasujOdpowiednik = "BG610"
        Case "CD"
            DopasujOdpowiednik = "BG620"
        Case "CE"
            DopasujOdpowiednik = "BG620"
        Case "CF"
            DopasujOdpowiednik = "BG700"
        Case "CG"
            DopasujOdpowiednik = "BG260"
        Case "CH"
            DopasujOdpowiednik = "BG680"
        Case "DA"
            DopasujOdpowiednik = "BG600"
        Case "DB"
            DopasujOdpowiednik = "BG600"
        Case "DC"
            DopasujOdpowiednik = "BG640"
        Case "DD"
            DopasujOdpowiednik = "BG690"
        Case "DE"
            DopasujOdpowiednik = "BG600"
        Case "DF"
            DopasujOdpowiednik = "BG600"
        Case "EA"
            DopasujOdpowiednik = "BG100"
        Case "EB"
            DopasujOdpowiednik = "BG100"
        Case "EC"
            DopasujOdpowiednik = "BG110"
        Case "ED"
            DopasujOdpowiednik = "BG110"
        Case "EE"
            DopasujOdpowiednik = "BG110"
        Case "EF"
            DopasujOdpowiednik = "BG110"
        Case "EG"
            DopasujOdpowiednik = "BG170"
        Case "FA"
            DopasujOdpowiednik = "BG400"
        Case "FB"
            DopasujOdpowiednik = "BG410"
        Case "FC"
            DopasujOdpowiednik = "BG440"
        Case "FD"
            DopasujOdpowiednik = "BG410"
        Case "FE"
            DopasujOdpowiednik = "BG440"
        Case "FF"
            DopasujOdpowiednik = "BG440"
        Case "GA"
            DopasujOdpowiednik = "BG420"
        Case "GB"
            DopasujOdpowiednik = "BG420"
        Case "GC"
            DopasujOdpowiednik = "BG420"
        Case "GD"
            DopasujOdpowiednik = "BG420"
        Case "GE"
            DopasujOdpowiednik = "BG420"
        Case "GF"
            DopasujOdpowiednik = "BG420"
        Case "HA"
            DopasujOdpowiednik = "BG430"
        Case "HB"
            DopasujOdpowiednik = "BG430"
        Case "HC"
            DopasujOdpowiednik = "BG430"
        Case "HD"
            DopasujOdpowiednik = "BG430"
        Case "HE"
            DopasujOdpowiednik = "BG430"
        Case "HF"
            DopasujOdpowiednik = "BG430"
        Case "JA"
            DopasujOdpowiednik = "BG420"
        Case "JB"
            DopasujOdpowiednik = "BG420"
        Case "JC"
            DopasujOdpowiednik = "BG420"
        Case "JD"
            DopasujOdpowiednik = "BG420"
        Case "JE"
            DopasujOdpowiednik = "BG420"
        Case "JF"
            DopasujOdpowiednik = "BG420"
        Case "JG"
            DopasujOdpowiednik = "BG420"
        Case "KA"
            DopasujOdpowiednik = "BG450"
        Case "KB"
            DopasujOdpowiednik = "BG700"
        Case "KC"
            DopasujOdpowiednik = "BG450"
        Case "LA"
            DopasujOdpowiednik = "BG450"
        Case "LB"
            DopasujOdpowiednik = "BG450"
        Case "LC"
            DopasujOdpowiednik = "BG450"
        Case "LD"
            DopasujOdpowiednik = "BG450"
        Case "LE"
            DopasujOdpowiednik = "BG450"
        Case "MA"
            DopasujOdpowiednik = "BG170"
        Case "MB"
            DopasujOdpowiednik = "BG170"
        Case "MC"
            DopasujOdpowiednik = "BG170"
        Case "MD"
            DopasujOdpowiednik = "BG170"
        Case "ME"
            DopasujOdpowiednik = "BG600"
        Case "MF"
            DopasujOdpowiednik = "BG600"
        Case "NA"
            DopasujOdpowiednik = "BG650"
        Case "NB"
            DopasujOdpowiednik = "BG650"
        Case "NC"
            DopasujOdpowiednik = "BG650"
        Case "ND"
            DopasujOdpowiednik = "BG650"
        Case "NE"
            DopasujOdpowiednik = "BG650"
        Case "PA"
            DopasujOdpowiednik = "BG420"
        Case "PB"
            DopasujOdpowiednik = "BG420"
        Case "PC"
            DopasujOdpowiednik = "BG420"
        Case "PD"
            DopasujOdpowiednik = "BG420"
        Case "PE"
            DopasujOdpowiednik = "BG600"
        Case "PF"
            DopasujOdpowiednik = "BG420"
        Case "QA"
            DopasujOdpowiednik = "BG500"
        Case "QB"
            DopasujOdpowiednik = "BG500"
        Case "QC"
            DopasujOdpowiednik = "BG500"
        Case "QD"
            DopasujOdpowiednik = "BG500"
        Case "QE"
            DopasujOdpowiednik = "BG500"
        Case "RA"
            DopasujOdpowiednik = "BG500"
        Case "RB"
            DopasujOdpowiednik = "BG500"
        Case "RC"
            DopasujOdpowiednik = "BG120"
        Case "SA"
            DopasujOdpowiednik = "BG700"
        Case "SB"
            DopasujOdpowiednik = "BG700"
        Case "SC"
            DopasujOdpowiednik = "BG700"
        Case "SD"
            DopasujOdpowiednik = "BG700"
        Case "SE"
            DopasujOdpowiednik = "BG700"
        Case "SF"
            DopasujOdpowiednik = "BG700"
        Case "SG"
            DopasujOdpowiednik = "BG700"
        Case "TA"
            DopasujOdpowiednik = "BG700"
        Case "TB"
            DopasujOdpowiednik = "BG700"
        Case "TC"
            DopasujOdpowiednik = "BG700"
        Case "TD"
            DopasujOdpowiednik = "BG420"
        Case "TE"
            DopasujOdpowiednik = "BG420"
        Case "UA"
            DopasujOdpowiednik = "BG460"
        Case "UB"
            DopasujOdpowiednik = "BG460"
        Case "UC"
            DopasujOdpowiednik = "BG460"
        Case "DU"
            DopasujOdpowiednik = "BG460"
        Case "UE"
            DopasujOdpowiednik = "BG460"
        Case "UF"
            DopasujOdpowiednik = "BG460"
        Case Else
            DopasujOdpowiednik = "Nie znaleziono BG"
    End Select
End Function
Function NextFilled(rStart As Range) As Long
  NextFilled = rStart.EntireColumn.Find(What:="?*", After:=rStart, LookIn:=xlValues).Row
  If NextFilled <= rStart.Row Then NextFilled = 0
End Function

Sub Baugruppiarka()

    Dim intLiczbaPozycji As Integer
    Dim strActiveWorksheet As String
    Dim temp As Integer
    Dim ostatniwiersz As Integer
    Dim zakres As String
    Dim komorka As Range
    Dim strtemp As String
    Dim ostatnianiepusta As Range
        
    '-----------------------PRZEPISYWANIE OBSZARU DOSTAWCY/STAMI DO KOLUMNY Z TL-----------------------------------------------------------------------------------------------------------------------------------------------------------
    zakres = "G6:G999" 'poczatkowe ustawienie zakresu, bedzie zmniejszane do petli
    strActiveWorksheet = ActiveSheet.Name ' nazwa aktualnego arkusza
    intLiczbaPozycji = Worksheets(strActiveWorksheet).Range("A6:A999").Cells.SpecialCells(xlCellTypeConstants).Count 'ilosc pozycji w zmianie
    
    For i = 1 To intLiczbaPozycji
        Range(zakres).Select
        Set komorka = Selection.Find(What:="Obszar dostawcy", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        
        If komorka Is Nothing Then
            'do it something
        Else
            Cells(komorka.Row, komorka.Column + 5).Value = komorka.Value
            ostatniwiersz = komorka.Row
            zakres = "G" & komorka.Row & ":G999"
        End If
    Next
    '--------------------------WPISYWANIE STADLER BUAGRUPPY ZAMIAST DIN BAUGRUPPY-----------------------------------------------------------------------------------------------------------------------------------------------------------
    'Range("Q6").Value = DopasujOdpowiednik(Range("Q6").Value)

    Set ostatnianiepusta = Range("A6")
    strtemp = "Q" & ostatnianiepusta.Row
    For i = 1 To intLiczbaPozycji
            Range(strtemp).Value = DopasujOdpowiednik(Range(strtemp).Value)
            strtemp = "Q" & NextFilled(ostatnianiepusta)
            If i = intLiczbaPozycji Then
            Else
                Set ostatnianiepusta = Range("A" & NextFilled(ostatnianiepusta))
            End If
    Next
    '-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    Range("A5").Select
    Range("A1").Select
End Sub
                                
                            

Paste Hosted With By Wklejamy.pl