Modül ile satır ekleyip veri yazdırma.

[rekkezum]

aşağıdaki modül de bir hata var ama bulamadım.sheet te a sütununda 0066 ve diğerleri ile başlayan satır gördüğünde yeni satır açarak c sütununa veri yazdırmaya çalışıyorum. bu arada a sütunu yerine f c sütunu yerine g yapmam lazım.sadece bu verilerin değiştirilmesi durumunda bile hata veriyor.

Sub Ekle()

Dim sat As Integer
For sat = 1 To Cells(65536, "a").End(xlUp).Row
If Cells(sat, "a") = "66" Then
Cells(sat, "a").EntireRow.Offset(1, 0).Insert shift:=xlDown
Cells(sat, "c").Offset(1, 0) = "CGK"
ElseIf Cells(sat, "a") = "15" Then
Cells(sat, "a").EntireRow.Offset(1, 0).Insert shift:=xlDown
Cells(sat, "c").Offset(1, 0) = "GRU"
ElseIf Cells(sat, "a") = "1176" Then
Cells(sat, "a").EntireRow.Offset(1, 0).Insert shift:=xlDown
Cells(sat, "c").Offset(1, 0) = "DOH"
ElseIf Cells(sat, "a") = "1178" Then
Cells(sat, "a").EntireRow.Offset(1, 0).Insert shift:=xlDown
Cells(sat, "c").Offset(1, 0) = "BAH"
ElseIf Cells(sat, "a") = "80" Then
Cells(sat, "a").EntireRow.Offset(1, 0).Insert shift:=xlDown
Cells(sat, "c").Offset(1, 0) = "CPT"
ElseIf Cells(sat, "a") = "6442" Then
Cells(sat, "a").EntireRow.Offset(1, 0).Insert shift:=xlDown
Cells(sat, "c").Offset(1, 0) = "AMM."
ElseIf Cells(sat, "a") = "6444" Then
Cells(sat, "a").EntireRow.Offset(1, 0).Insert shift:=xlDown
Cells(sat, "c").Offset(1, 0) = "AMM."
ElseIf Cells(sat, "a") = "6362" Then
Cells(sat, "a").EntireRow.Offset(1, 0).Insert shift:=xlDown
Cells(sat, "c").Offset(1, 0) = "DEL."
ElseIf Cells(sat, "a") = "6360" Then
Cells(sat, "a").EntireRow.Offset(1, 0).Insert shift:=xlDown
Cells(sat, "c").Offset(1, 0) = "DEL."
ElseIf Cells(sat, "a") = "6335" Then
Cells(sat, "a").EntireRow.Offset(1, 0).Insert shift:=xlDown
Cells(sat, "c").Offset(1, 0) = "CDG."
ElseIf Cells(sat, "a") = "6366" Then
Cells(sat, "a").EntireRow.Offset(1, 0).Insert shift:=xlDown
Cells(sat, "c").Offset(1, 0) = "CAI."
ElseIf Cells(sat, "a") = "6391" Then
Cells(sat, "a").EntireRow.Offset(1, 0).Insert shift:=xlDown
Cells(sat, "c").Offset(1, 0) = "MXP."
ElseIf Cells(sat, "a") = "6381" Then
Cells(sat, "a").EntireRow.Offset(1, 0).Insert shift:=xlDown
Cells(sat, "c").Offset(1, 0) = "ZRH."
ElseIf Cells(sat, "a") = "6393" Then
Cells(sat, "a").EntireRow.Offset(1, 0).Insert shift:=xlDown
Cells(sat, "c").Offset(1, 0) = "MXP."
ElseIf Cells(sat, "a") = "6395" Then
Cells(sat, "a").EntireRow.Offset(1, 0).Insert shift:=xlDown
Cells(sat, "c").Offset(1, 0) = "MXP."
ElseIf Cells(sat, "a") = "6417" Then
Cells(sat, "a").EntireRow.Offset(1, 0).Insert shift:=xlDown
Cells(sat, "c").Offset(1, 0) = "MAD."
End If
Next
End Sub

 

[halit3]

Bunun yerine

For sat = 1 To Cells(65536, "a").End(xlUp).Row

bunu denermisiniz.

For sat = Cells(65536, "a").End(xlUp).Row To 1 Step -1

 

[rekkezum]

Bunun yerine

For sat = 1 To Cells(65536, "a").End(xlUp).Row

bunu denermisiniz.

For sat = Cells(65536, "a").End(xlUp).Row To 1 Step -1

selamlar dostum
ektaki dosyaya bakabilirmisin.teşekkürler.......