DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub test()
Application.ScreenUpdating = False
Dim sagSut As Single
Dim lst
Dim specName, specGroup As String
specGroup = "Güneş Gözlüğü"
specName = Array("Ekartman", "Cam Malzemesi", "Fotokromatik mi ?", "Polarize mi ?", "Cam Organik mi ?", "Sap Uzunluğu", "Köprü Ölçüsü", "Cam Genişliği", "Cam Yüksekliği", "Gövde Rengi", "Gözlük Sap Malzemesi", "Gövde Ön Malzemesi", "Cinsiyet", "Çerçeve Şekli", "Cam Rengi", "Cam Bombesi")
ReDim Preserve specName(1 To 16)
Range("a2:d" & Rows.Count).ClearContents
sagSut = Cells(1, Columns.Count).End(1).Column
ReDim lst(1 To 16 * sagSut, 1 To 4)
For i = 6 To sagSut
For ii = 1 To 16
sira = ((i - 6) * 16) + ii
lst(sira, 1) = Cells(1, i)
lst(sira, 2) = specGroup
lst(sira, 3) = specName(ii)
lst(sira, 4) = Cells(ii + 1, i)
Next ii
Next i
Range("A2").Resize(sira, 4).Value = lst
Application.ScreenUpdating = True
End Sub