DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Set VERİ = Sheets("VERİ")
Set SV = Sheets("V")
Set SP = Sheets("P")
SV.[A2:D65536].ClearContents
SP.[A2:D65536].ClearContents
For Y = 3 To VERİ.[A65536].End(3).Row
For X = 4 To VERİ.Cells(Y, 256).End(xlToLeft).Column Step 2
SVSATIR = SV.[A65536].End(3).Row
SPSATIR = SP.[A65536].End(3).Row
If VERİ.Cells(Y, X) = "V" Then
SV.Cells(SVSATIR + 1, 1) = VERİ.Cells(Y, 1)
SV.Cells(SVSATIR + 1, 2) = CDate(VERİ.Cells(Y, 2))
SV.Cells(SVSATIR + 1, 3) = VERİ.Cells(Y, X - 1)
SV.Cells(SVSATIR + 1, 4) = VERİ.Cells(2, X - 1)
ElseIf VERİ.Cells(Y, X) = "P" Then
SP.Cells(SPSATIR + 1, 1) = VERİ.Cells(Y, 1)
SP.Cells(SPSATIR + 1, 2) = CDate(VERİ.Cells(Y, 2))
SP.Cells(SPSATIR + 1, 3) = VERİ.Cells(Y, X - 1)
SP.Cells(SPSATIR + 1, 4) = VERİ.Cells(2, X - 1)
End If
Next X
Next Y
Application.ScreenUpdating = False
MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub