DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
hüseyin bey, kastettiğiniz hangi sayfa hangi model olacak ise ekli dosyada sütuna işledim, teşekkürler...
Sub kod()
Application.ScreenUpdating = False
Sheets("GİRİŞ").Select
Sheets("BDO").Range("A2:F65536").ClearContents
Sheets("ÖZ").Range("A2:F65536").ClearContents
Sheets("İİ").Range("A2:F65536").ClearContents
Sheets("ÖA").Range("A2:F65536").ClearContents
Sheets("SOR").Range("A2:F65536").ClearContents
Sheets("MUA").Range("A2:F65536").ClearContents
Sheets("MNF").Range("A2:F65536").ClearContents
Sheets("DNŞ").Range("A2:F65536").ClearContents
Sheets("DİG").Range("A2:F65536").ClearContents
For i = 2 To [A65536].End(3).Row
If Cells(i, "A") <> "" Then
sayfaismi = Cells(i, "K")
sonsat = Sheets(sayfaismi).[A65536].End(3).Row + 1
Sheets(sayfaismi).Cells(sonsat, "A") = sonsat - 1
Sheets(sayfaismi).Cells(sonsat, "B") = Cells(i, "B")
Sheets(sayfaismi).Cells(sonsat, "C") = Cells(i, "C")
Sheets(sayfaismi).Cells(sonsat, "D") = Cells(i, "L")
Sheets(sayfaismi).Cells(sonsat, "E") = Cells(i, "N")
Sheets(sayfaismi).Cells(sonsat, "F") = Cells(i, "BB")
Else: End If
Next i
Application.ScreenUpdating = True
MsgBox " B i t t i "
End Sub