Nerde hata yapıyorum ?

Katılım
14 Ağustos 2008
Mesajlar
82
Excel Vers. ve Dili
2003 - english
Nerde hata yaptığımı söyleyebilir misiniz ?
Sub DENE()
Dim i, slu, slf As Integer
Sheets("Sheet2").Select
slu = 1
For i = 0 To 100
Range("A" & i).Select
Select Case ActiveCell.Value
Case "ÜRÜN:"
Range("G" & i).Select
Selection.Copy
Selection.Copy Destination:=Sheets("Sheet1").Range("B" & slu)
slf = slu + 2
slu = slu + 17

Sheets("Sheet2").Select
Range("B" & i).Select
Selection.Copy
Selection.Copy Destination:=Sheets("Sheet1").Range("L" & slu)

Sheets("Sheet2").Select
Range("O" & i).Select
Selection.Copy
Selection.Copy Destination:=Sheets("Sheet1").Range("L" & slf)

Sheets("Sheet2").Select
Range("A" & i).Select

End
End Sub
 
Katılım
17 Ocak 2008
Mesajlar
185
Excel Vers. ve Dili
2003 Türkçe - 2007 Türkçe
Nerde hata yaptığımı söyleyebilir misiniz ?
kodlarınız aşağıdaki şekilde olmalıdır...


Sub DENE()
Dim i, slu, slr, slf As Integer
Dim r As Boolean
Sheets("Sheet2").Select
slu = 1
For i = 1 To 100
Range("A" & i).Select
Select Case ActiveCell.Value
Case "ÜRÜN:"
Range("G" & i).Select
Selection.Copy
Selection.Copy Destination:=Sheets("Sheet1").Range("B" & slu)
slr = slu + 3
slf = slu + 2
slu = slu + 17

Sheets("Sheet2").Select
Range("B" & i).Select
Selection.Copy
Selection.Copy Destination:=Sheets("Sheet1").Range("L" & slu)

Sheets("Sheet2").Select
Range("O" & i).Select
Selection.Copy
Selection.Copy Destination:=Sheets("Sheet1").Range("L" & slf)

Sheets("Sheet2").Select
Range("A" & i).Select
End Select
Next i
End Sub
 
Katılım
14 Ağustos 2008
Mesajlar
82
Excel Vers. ve Dili
2003 - english
yeni birşey daha ekledim yine hata veriyor...

Sub DENE()
Dim i, slu, slr, slf As Integer
Dim r As Boolean
Sheets("Sheet2").Select
slu = 1
For i = 0 To 100
Range("A" & i).Select
Select Case ActiveCell.Value
Case "ÜRÜN:"
Range("G" & i).Select
Selection.Copy
Selection.Copy Destination:=Sheets("Sheet1").Range("B" & slu)
slr = slu + 3
slf = slu + 2
slu = slu + 17

Sheets("Sheet2").Select
Range("B" & i).Select
Selection.Copy
Selection.Copy Destination:=Sheets("Sheet1").Range("L" & slu)

Sheets("Sheet2").Select
Range("O" & i).Select
Selection.Copy
Selection.Copy Destination:=Sheets("Sheet1").Range("L" & slf)

Sheets("Sheet2").Select
Range("A" & i).Select

Case "Renk"
Sheets("Sheet2").Select
Range("A" & i).Select
Selection.Copy
Selection.Copy Destination:=Sheets("Sheet1").Range("A" & slr)
r = True
Sheets("Sheet2").Select
Range("A" & slr).Select
slr = slr + 1
Select Case ActiveCell.Value
Case "TOPLAM"
r = False
Case Else
If r = True Then

Else
End If
End Select
Next i
End Sub
 
Katılım
17 Ocak 2008
Mesajlar
185
Excel Vers. ve Dili
2003 Türkçe - 2007 Türkçe
Aşağıdakini aynen kopyalayın...
*** Koşul koymuşsunuz ancak koşul gerçekleştiğinde uygulanacak işlemleri belirtmemişsiniz, onlarıda tamamlarsınız artık :)


Sub DENE()
Dim i, slu, slr, slf As Integer
Dim r As Boolean
Sheets("Sheet2").Select
slu = 1
For i = 1 To 100
Range("A" & i).Select
Select Case ActiveCell.Value
Case "ÜRÜN:"
Range("G" & i).Select
Selection.Copy
Selection.Copy Destination:=Sheets("Sheet1").Range("B" & slu)
slr = slu + 3
slf = slu + 2
slu = slu + 17

Sheets("Sheet2").Select
Range("B" & i).Select
Selection.Copy
Selection.Copy Destination:=Sheets("Sheet1").Range("L" & slu)

Sheets("Sheet2").Select
Range("O" & i).Select
Selection.Copy
Selection.Copy Destination:=Sheets("Sheet1").Range("L" & slf)

Sheets("Sheet2").Select
Range("A" & i).Select

Case "Renk"
Sheets("Sheet2").Select
Range("A" & i).Select
Selection.Copy
Selection.Copy Destination:=Sheets("Sheet1").Range("A" & slr)
r = True
Sheets("Sheet2").Select
Range("A" & slr).Select
slr = slr + 1
End Select

Select Case ActiveCell.Value
Case "TOPLAM"
r = False
Case Else
If r = True Then

Else

End If
End Select
Next i

End Sub
 
Katılım
14 Ağustos 2008
Mesajlar
82
Excel Vers. ve Dili
2003 - english
Selection.Copy Destination:=Sheets("Sheet1").Range("A" & slr)
derken ben yapılacak işlemi belirttiğimi sanmıştım :S
Renk yazısının altındaki kısımdan TOPLAM yazan yere kadar olan renk kodlarını tabloya ekletmek istiyorum.
Nereye girmem gerekiyor ? daha çok yeniyim...
 
Son düzenleme:

Ayhan Ercan

Özel Üye
Katılım
10 Ağustos 2005
Mesajlar
1,571
Excel Vers. ve Dili
Microsoft 365- Türkçe
Merhaba

Kodunuzda eksikler var.

Eksiklerini tamamlamaya çalıştım.Deneyiniz...

Kod:
Sub DENE()
Dim i, slu, slr, slf As Integer
Dim r As Boolean
Sheets("Sheet2").Select
slu = 1
    For i = 1 To 100
        Range("A" & i).Select
            Select Case ActiveCell.Value
                Case "ÜRÜN:"
                    Range("G" & i).Select
                    Selection.Copy
                    Selection.Copy Destination:=Sheets("Sheet1").Range("B" & slu)
                    slr = slu + 3
                    slf = slu + 2
                    slu = slu + 17
                    
                    Sheets("Sheet2").Select
                    Range("B" & i).Select
                    Selection.Copy
                    Selection.Copy Destination:=Sheets("Sheet1").Range("L" & slu)
                    
                    Sheets("Sheet2").Select
                    Range("O" & i).Select
                    Selection.Copy
                    Selection.Copy Destination:=Sheets("Sheet1").Range("L" & slf)
                    
                    Sheets("Sheet2").Select
                    Range("A" & i).Select
                
                Case "Renk"
                    Sheets("Sheet2").Select
                    Range("A" & i).Select
                    Selection.Copy
                    Selection.Copy Destination:=Sheets("Sheet1").Range("A" & slr)
                    r = True
                    Sheets("Sheet2").Select
                    Range("A" & slr).Select
                    slr = slr + 1
                Case "TOPLAM"
                    r = False
                Case Else
                    If r = True Then
                    Else
                    End If
            End Select
    Next i
End Sub
 
Katılım
14 Ağustos 2008
Mesajlar
82
Excel Vers. ve Dili
2003 - english
Ayhan bey ve exam77 ilginize teşekkürler ama olmadı, Renk yazan yerin altındaki sayıları, tabloda gösterdiğim yere yapıştırmasını istiyorum, yani Renk yazısının yazılmasını istemiyorum, birazdan şekille anlatımıda ekleyeceğim. Şimdiden sağolun
 
Son düzenleme:
Katılım
14 Ağustos 2008
Mesajlar
82
Excel Vers. ve Dili
2003 - english
Şekildeki gibi o yeşil renkli kısımları, sağdaki gibi yerleştirmek istiyorum.
 
Üst