• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Aktar makrosunun revize edilmesi gerekiyor.

  • Konbuyu başlatan Konbuyu başlatan s.savas
  • Başlangıç tarihi Başlangıç tarihi
S

s.savas

Katılım
12 Ocak 2009
Mesajlar
838
Excel Vers. ve Dili
2003
Arkadaşlar iyi akşamlar.
Aşağıdaki kod ile ekte sunulan belgenin İcmal sayfasında bulunan Aktar butonu ile 1 den 8 numaralı sayfalara kadar olan sekmelerdeki A34, Y34,AD34, AI34 ve AN34 numaralı hücrelerindeki verileri B8 -F15 aralığına alıyorum. Ancak verileri almaya başlarken 8.sayfadan başlayıp 1.sayfada bitiriyor. Bu işlemi 1.sayfadan başlayıp 8. sayfada bitirmesini istiyorum.
İlgilenecek arkadaşlara teşekkür ederim.

Kod: 
Private Sub CommandButton1_Click()
Dim i As Integer, s As Worksheet, toplam As Double
Set s = Sheets("İcmal")
For i = 1 To Sheets.Count
If CStr(Sheets(i).Name) = CStr(i - 6) Then
s.Range("b8").Value = Sheets(i).Range("a34").Value
s.Range("c8").Value = Sheets(i).Range("y34").Value
s.Range("d8").Value = Sheets(i).Range("ad34").Value
s.Range("e8").Value = Sheets(i).Range("aI34").Value
s.Range("f8").Value = Sheets(i).Range("aN34").Value
On Local Error Resume Next
toplam = toplam + s.Range("f8").Value
Err.Clear
If i = Sheets.Count Then Exit For
Rows("8:8").Insert Shift:=xlDown
End If
Next i
s.Range("e65536").End(3)(1, 2).Value = toplam
i = Empty: toplam = Empty: Set s = Nothing
End Sub
 

Ekli dosyalar

böyle denermisiniz.

Private Sub CommandButton1_Click()
Dim i As Integer, j As Integer, r As Integer, s As Worksheet, toplam As Double
Set s = Sheets("İcmal")
j = 8
For i = 1 To Sheets.Count
If CStr(Sheets(i).Name) = CStr(i - 6) Then
r = r + 1
s.Cells(j, "a").Value = r
s.Cells(j, "b").Value = Sheets(i).Range("a34").Value
s.Cells(j, "c").Value = Sheets(i).Range("y34").Value
s.Cells(j, "d").Value = Sheets(i).Range("ad34").Value
s.Cells(j, "e").Value = Sheets(i).Range("aI34").Value
s.Cells(j, "f").Value = Sheets(i).Range("aN34").Value
s.Range("A" & j & ":F" & j).Select
Selection.Borders(7).LineStyle = xlContinuous
Selection.Borders(8).LineStyle = xlContinuous
Selection.Borders(9).LineStyle = xlContinuous
Selection.Borders(10).LineStyle = xlContinuous
Selection.Borders(11).LineStyle = xlContinuous
On Local Error Resume Next
toplam = toplam + Sheets(i).Range("aN34").Value
j = j + 1
Err.Clear
If i = Sheets.Count Then Exit For
Rows(j).Insert Shift:=xlDown
End If
Next i
s.Range("e65536").End(3)(1, 2).Value = toplam
i = Empty: toplam = Empty: Set s = Nothing
End Sub
Genişletmek için tıkla ...
 
kod aşağıdaki mesajda
 
bu kodu denermisiniz. sayı değeri olan sayfaların hepsinden verileri alıyor.
Private Sub CommandButton1_Click()
Dim i As Integer, j As Integer, s As Worksheet, toplam As Double
Set s = Sheets("İcmal")
j = s.Cells(Rows.Count, "B").End(3).Row + 1
For i = 1 To Sheets.Count
If IsNumeric(Sheets(i).Name) = True Then
s.Cells(j, "a").Value = j - 7
s.Cells(j, "b").Value = Sheets(i).Range("a34").Value
s.Cells(j, "c").Value = Sheets(i).Range("y34").Value
s.Cells(j, "d").Value = Sheets(i).Range("ad34").Value
s.Cells(j, "e").Value = Sheets(i).Range("aI34").Value
s.Cells(j, "f").Value = Sheets(i).Range("aN34").Value
s.Cells(j, "e").Font.Bold = False
s.Cells(j, "f").Font.Bold = False
s.Range("A" & j & ":F" & j).Select
Selection.Borders(7).LineStyle = xlContinuous
Selection.Borders(8).LineStyle = xlContinuous
Selection.Borders(9).LineStyle = xlContinuous
Selection.Borders(10).LineStyle = xlContinuous
Selection.Borders(11).LineStyle = xlContinuous
toplam = toplam + Sheets(i).Range("aN34").Value
j = j + 1
End If
Next i
s.Cells(j, "e").Value = "Toplam Tutar"
s.Cells(j, "f").Value = toplam
s.Cells(j, "F").Value = WorksheetFunction.Sum(s.Range("F8:F" & j - 1))
s.Cells(j, "e").Font.Bold = True
s.Cells(j, "f").Font.Bold = True
s.Cells(j + 6, "a").Value = "Üye"
s.Cells(j + 6, "c").Value = "Üye"
s.Cells(j + 6, "f").Value = "Üye"
End Sub
Genişletmek için tıkla ...
 
halit3' Alıntı:
böyle denermisiniz.
Genişletmek için tıkla ...

Halit hocam çok teşekkürler yazdığınız kod mükemmel çalışıyor ve tam istediğim gibi.
Yazdığınız kodunuzu kullanmak istediğim orjinal dosyama uyarladım, ancak bir iki ufak sorun yaşadım, sorunun kaynağını deneme yanılma ile bulamadım.

Sorunumu ekteki dosyada izah etmeye çalıştım.
 

Ekli dosyalar

Son düzenleme:
uyarı ! yardım isterken dosyanızın orjinal halini göndermeye,gönderilen dosyada özel bilgileriniz olmamasına ve küçük boyutta olmasına özen gösteriniz. yoksa kodu yeniden revize etmek gerekiyor.

aşağıdaki kodu denermisiniz.

Private Sub CommandButton1_Click()
Dim i As Integer, j As Integer, s As Worksheet, toplam As Double
Set s = Sheets("İcmal")
j = s.Cells(Rows.Count, "B").End(3).Row + 1
For i = 1 To Sheets.Count
If IsNumeric(Sheets(i).Name) = True Then
s.Cells(j, "a").Value = j - 16
s.Cells(j, "b").Value = Sheets(i).Range("a34").Value
s.Cells(j, "c").Value = Sheets(i).Range("y34").Value
s.Cells(j, "d").Value = Sheets(i).Range("ad34").Value
s.Cells(j, "e").Value = Sheets(i).Range("aI34").Value
s.Cells(j, "f").Value = Sheets(i).Range("aN34").Value
s.Cells(j, "e").Font.Bold = False
s.Cells(j, "f").Font.Bold = False

toplam = toplam + Sheets(i).Range("aN34").Value
j = j + 1
End If
Next i
s.Range("A17" & ":F" & j - 1).Select
Selection.Borders(7).LineStyle = xlContinuous
Selection.Borders(8).LineStyle = xlContinuous
Selection.Borders(9).LineStyle = xlContinuous
Selection.Borders(10).LineStyle = xlContinuous
Selection.Borders(11).LineStyle = xlContinuous
Selection.Borders(12).LineStyle = xlContinuous

s.Cells(j, "e").Value = "Toplam Tutar"
s.Cells(j, "f").Value = toplam
s.Cells(j, "F").Value = WorksheetFunction.Sum(s.Range("F17:F" & j - 1))
s.Cells(j, "e").Font.Bold = True
s.Cells(j, "f").Font.Bold = True
s.Cells(j + 6, "a").Value = "Üye"
s.Cells(j + 6, "c").Value = "Üye"
s.Cells(j + 6, "f").Value = "Üye"
End Sub
Genişletmek için tıkla ...
 
Halit hocam uyarınız için teşekkür ederim. Makro bilgim çok zayıf olduğu için hangi kodun ne görev yaptığını deneme yanılma yöntemi ile öğrenmeye çalışıyorum, o yüzden ilk mesajda örnek dosya eklemiştim.

5. mesajdaki orjinal dosyada 36,39,40 ve 41. satırlarda silinmemesi gereken veriler var, bu yüzden 17.satırdan itibaren yaklaşık maliyetlerden alınan verilerin satır eklenerek alınması gerekmekte idi.
2. mesajda yazdığınız kod bu işi tam anlamı ile yerine getiriyor. Sadece 5 numaralı mesajda ifade ettiğim hatalarımın giderilmesi sorunun çözümüne yeterli olacağını düşünüyorum.
 
Son düzenleme:
sayfanın sabit olduğunu düşünerek kodu yeniden düzenledim 36,39,40,41 nolu satılardaki verileride otomatik atıyor.
 

Ekli dosyalar

Emek ve katkı için teşekkürler ve iyi hafta sonları...
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst