VBA HK

[üveyin]

Arkadaşlar mevcut olan koduma ekli dosyamdaki (L) sütunundaki material kalınlıklarını farklı olarak kaydettiğim Csv dosyam daki sekmelerde kalınlıklara göre kayıt yapmasınına ihtiyacım var böyle bir kod yazılabilir mi mümkün mü şimdiden emekleriniz için teşekkür ederim.

Private Sub CommandButton1_Click()
cevap = MsgBox("Dosya farklı kaydedilecek emin misiniz ?", vbYesNo)
If cevap = vbYes Then

Dim i As Integer, j As Integer, myrng As Range
Dim filename As String, fNum As Byte, Baslik As String

fNum = FreeFile

filename = ThisWorkbook.Path & "\Ebatlama Formu-" & Format(Now, "ddmmyy-hhmmss") & ".csv"

Open filename For Output As fNum
Baslik = Join(Application.Transpose(Application.Transpose(Sheets("ÖLÇÜ LİSTESİ").Range("BY1:CI1").Value)), ";")
Print #1, Baslik
Baslik = Join(Application.Transpose(Application.Transpose(Sheets("ÖLÇÜ LİSTESİ").Range("BY2:CI2").Value)), ";")
Print #1, Baslik

For i = 6 To 1000
If Range("B" & i).Value <> "" Then
If Range("B" & i).Value <> 0 And Range("U" & i).Value <> 0 Then
ifade = ifade & Range("B" & i).Value & ";" & Range("C" & i).Value & ";" & Range("D" & i).Value & ";"
Else
ifade = ifade & Range("B" & i).Value & ";" & Range("C" & i).Value & ";" & Range("D" & i).Value & ";"

End If
ifade = ifade & Range("E" & i).Value & ";" & Range("F" & i).Value & ";" & Range("G" & i).Value & ";" & Range("H" & i).Value & ";"
ifade = ifade & Range("I" & i).Value & ";" & Range("J" & i).Value & ";" & Range("U" & i).Value & ";" & Range("N" & i).Value

Print #1, ifade
ifade = ""
End If
Next i
Close #1

MsgBox ("Csv Dosya kaydedildi.")
End If
End Sub