Satır belirlemek

[ckayaz]

Arkadaşlar aşagıdaki kodu yine bu formdan bir usta yardımıyla elde etmiştim. Şimdi istediğim 575. satıra kadar işlem yapsın 576. satırdan sonra yazılan formülleri silmemesi için 575 te işlemi kesebilirmi

Sub Aktar()
Dim S1 As Worksheet, S2 As Worksheet
Dim STR As Long, STR1 As Long, CPY As Long
Application.ScreenUpdating = False
Set S1 = Sheets("AnaSayfa")
Set S2 = Sheets("Dagıtım")
S1.Range("G4:G" & Rows.Count).ClearContents
S1.Range("J4:L" & Rows.Count).ClearContents
For STR = 3 To S2.Range("B" & Rows.Count).End(xlUp).Row
STR1 = S1.Range("G" & Rows.Count).End(xlUp).Row + 1
CPY = Left(S2.Cells(STR, "F"), InStr(1, S2.Cells(STR, "F"), " ", vbTextCompare) - 1)
S1.Range("G" & STR1 & ":G" & CPY + STR1 - 1) = S2.Cells(STR, "B")
S1.Range("J" & STR1 & ":J" & CPY + STR1 - 1) = S2.Cells(STR, "C")
S1.Range("K" & STR1 & ":K" & CPY + STR1 - 1) = S2.Cells(STR, "D")
S1.Range("L" & STR1 & ":L" & CPY + STR1 - 1) = S2.Cells(STR, "E")
Next
Application.ScreenUpdating = True
MsgBox "İşlem Sonucu"
End Sub

 

[antonio]

Arkadaşlar aşagıdaki kodu yine bu formdan bir usta yardımıyla elde etmiştim. Şimdi istediğim 575. satıra kadar işlem yapsın 576. satırdan sonra yazılan formülleri silmemesi için 575 te işlemi kesebilirmi

Sub Aktar()
Dim S1 As Worksheet, S2 As Worksheet
Dim STR As Long, STR1 As Long, CPY As Long
Application.ScreenUpdating = False
Set S1 = Sheets("AnaSayfa")
Set S2 = Sheets("Dagıtım")
S1.Range("G4:G" & Rows.Count).ClearContents
S1.Range("J4:L" & Rows.Count).ClearContents
For STR = 3 To S2.Range("B" & Rows.Count).End(xlUp).Row
STR1 = S1.Range("G" & Rows.Count).End(xlUp).Row + 1
CPY = Left(S2.Cells(STR, "F"), InStr(1, S2.Cells(STR, "F"), " ", vbTextCompare) - 1)
S1.Range("G" & STR1 & ":G" & CPY + STR1 - 1) = S2.Cells(STR, "B")
S1.Range("J" & STR1 & ":J" & CPY + STR1 - 1) = S2.Cells(STR, "C")
S1.Range("K" & STR1 & ":K" & CPY + STR1 - 1) = S2.Cells(STR, "D")
S1.Range("L" & STR1 & ":L" & CPY + STR1 - 1) = S2.Cells(STR, "E")
Next
Application.ScreenUpdating = True
MsgBox "İşlem Sonucu"
End Sub

Yukarıda ki kodunuzda geçen

For STR = 3 To S2.Range("B" & Rows.Count).End(xlUp).Row

satırını aşağıda ki şekilde değiştirin.

For STR = 3 To 575

 

[ckayaz]

575. satırdan sonra yazmış olduğum formülleri sildiği gibi aşağıdaki satırda hata veriyor. hata kodunu veriyor ama yapması gereken işlemide yapıyor

CPY = Left(S2.Cells(STR, "F"), InStr(1, S2.Cells(STR, "F"), " ", vbTextCompare) - 1)

hata kodu olarakta

Run-Time error '5':
invalid prodedure call or argument

 

[antonio]

575. satırdan sonra yazmış olduğum formülleri sildiği gibi aşağıdaki satırda hata veriyor. hata kodunu veriyor ama yapması gereken işlemide yapıyor

CPY = Left(S2.Cells(STR, "F"), InStr(1, S2.Cells(STR, "F"), " ", vbTextCompare) - 1)

hata kodu olarakta

Run-Time error '5':
invalid prodedure call or argument

575.nci satırdan sonraki formüllerinizin yada verilerinizin silinmesini gerçekleştiren kod:

S1.Range("G4:G" & Rows.Count).ClearContents
S1.Range("J4:L" & Rows.Count).ClearContents

şeklinde ki koddur.
kodlara bakılırsa önce listeyi temizliyor, sonra kodları çalıştırıyor. Siz 575.nci satırda dursun dediğinizde, silme durumunun sıkıntı yaratacağını bilemezdim.
O halde yukarıda ki kodları hiç değiştirmeden bir kez daha çalıştırın, sonra belirtitğim değişikliği yapmakla birlikte, yukarıda belirttiğim kodları da aşağıda ki gibi değiştirin.

S1.Range("G4:G575").ClearContents
S1.Range("J4:L575").ClearContents

 

[ckayaz]

Sayın antonio yardımınız için teşekkür ederim ama nedense olmadı. Benim eklemiş olduğu dosyada eski kodlar var. sizin eklediğiniz kodları ekleyince bu defa verileri anasayfaya 576. satırdan itibaren atıyor. Özellikle sayfayı açtığınızda AnaSayfa 576. satıra dikkat edip makroyu çalıştırın. sonrada sizin eklediğiniz kodları çalıştırın
Dosyam ektedir

 

[antonio]

Sayın antonio yardımınız için teşekkür ederim ama nedense olmadı. Benim eklemiş olduğu dosyada eski kodlar var. sizin eklediğiniz kodları ekleyince bu defa verileri anasayfaya 576. satırdan itibaren atıyor. Özellikle sayfayı açtığınızda AnaSayfa 576. satıra dikkat edip makroyu çalıştırın. sonrada sizin eklediğiniz kodları çalıştırın
Dosyam ektedir

Dosyanızın kodlarına açıklamalarını da ekleyerek düzelttim. Anlaşılması için Dağıtım sayfasında ki yazılacak öğe sayısını arttırdım. Normalde 900.ncü satırdan fazlasına yazması gerekiyorken, tam 575.nci satırda kestiğini göreceksiniz. Bunun nasıl yapıldığını ayrıntılı olarak kodların açıklamalarına yazdım.
Benden bu kadar.

 

[ckayaz]

Arkadaşlar aşagıdaki kodu yine bu formdan bir usta yardımıyla elde etmiştim. Şimdi istediğim 575. satıra kadar işlem yapsın 576. satırdan sonra yazılan formülleri silmemesi için 575 te işlemi kesebilirmi

Sub Aktar()
Dim S1 As Worksheet, S2 As Worksheet
Dim STR As Long, STR1 As Long, CPY As Long
Application.ScreenUpdating = False
Set S1 = Sheets("AnaSayfa")
Set S2 = Sheets("Dagıtım")
S1.Range("G4:G" & Rows.Count).ClearContents
S1.Range("J4:L" & Rows.Count).ClearContents
For STR = 3 To S2.Range("B" & Rows.Count).End(xlUp).Row
STR1 = S1.Range("G" & Rows.Count).End(xlUp).Row + 1
CPY = Left(S2.Cells(STR, "F"), InStr(1, S2.Cells(STR, "F"), " ", vbTextCompare) - 1)
S1.Range("G" & STR1 & ":G" & CPY + STR1 - 1) = S2.Cells(STR, "B")
S1.Range("J" & STR1 & ":J" & CPY + STR1 - 1) = S2.Cells(STR, "C")
S1.Range("K" & STR1 & ":K" & CPY + STR1 - 1) = S2.Cells(STR, "D")
S1.Range("L" & STR1 & ":L" & CPY + STR1 - 1) = S2.Cells(STR, "E")
Next
Application.ScreenUpdating = True
MsgBox "İşlem Sonucu"
End Sub

olmadı sayın antonio yinede teşekkür ederim

ustalar bir el atabilirmi acaba

 

[ZorBey_]

Merhaba
İyi Çalışmalar
Dosyanız Ektedir.

 

[ckayaz]

sayın asr35 çok teşekkür ederim, benim işimi fazlasıyla gördü.
Fakat merakımı bagışlayın neden ayrıca aynı sayfaya (Dagıtım sayfasında) sıralayıp anasayfa ya makro ile atma ihtiyacı duydunuz.