X belgesindeki A hücresini Y belgesindeki B hücresine kopyalamak.

[sacid55]

selamlar..
ben işyerinde java tabanlı bir yazılımdan her ay excel çıktısı alıyorum.
o çıktıdaki (her zaman aynı satır ve sütunda olan veriyi) kendi tabloma (bendeki tabloda her ay ayrı sütunda olmak üzere) kopyalayacak makro komutu arıyorum.
Aynı şekilde 100e yakın komut girişi yapacağım.
Bir makroda bunları toplayabilir miyim?
sorum anlaşılmazsa farklı şekilde anlatabilirim.
saygılar...

 

[Murat OSMA]

Dosyanız üzerinde anlatırsanız daha iyi anlaşılır...

 

[sacid55]

her ay karne adlı dosyayı sistemden çekiyorum.
her ay aldığım bu veride hücreler hep sabittir.
bu tablodan "tüm gösterge kartları ..." isimli tablomdaki ilgili aya verilerin otomatik olarak geçmesini istiyorum.
Yani; her ay ben aynı klasör içine 2 dosyayı da koysam, karne 01 (ocak) , karne 02 v.s. .... ve "tüm gösterge kartları ..." isimli tablomdaki ilgili ay sütunu o aya ait dosyayı gördüğünde veriyi oradan kendi hücrelerine kopyalasa ...

 

[Murat OSMA]

Tüm Gösterge Kartları dosyasındaki hangi sayfa ve hangi hücreye, Karne dosyasındaki hangi hücre aktarılacak bunu belirtir misiniz ?

 

[sacid55]

üşenmezseniz ben size uzunca yazarım ama ben ezbere yapmak istemiyorum.işin mantığını öğretebilirseniz daha memnun olurum. siz örnek bir sayfa ve hücre seçebilirsiniz...
ÖR: karne N2 , Tüm Gösterge Kartları "tıbbi kriterler" F7

 

[Murat OSMA]

İki dosya da aynı klasörde olsun..

Şu kodları Tüm Gösterge Kartları dosyasında Module içerisine yapıştırıp deneyiniz;

Option Compare Text
Sub Emre()
    Dim i As Integer, Rky As Workbook
    Application.ScreenUpdating = False
    Set Rky = Workbooks.Open(ThisWorkbook.Path & "\karne.xlsx")
    With ThisWorkbook.Sheets(1)
        For i = 6 To 22
            If .Cells(5, i) = VBA.MonthName(Range("B2").Value, False) Then
               .Cells(7, i) = Range("N2").Value
            End If
        Next i
    End With
    Rky.Close False
    Application.ScreenUpdating = True
End Sub

 

[sacid55]

tmm şimdi deneyeceğim

 

[Murat OSMA]

Yapamazsanız dosyayı da ekleyebilirim..

 

[sacid55]

denedim oldu..
şimdi ben bu aynı komutu farklı hücreler için kopyalayıp aynı modül altına sürekli yapıştırsam yeni eklediklerim de çalışır mı?

 

[sacid55]

ya da bu koddaki her satırın manasını bana açıklarsanız çok sevineceğim..
saygılar...

 

[Murat OSMA]

Siz sadece bu satırı kopyalayacaksınız;
.Cells(7, i) = Range("N2").Value


Bu satır: Tüm Gösterge Kartları dosyasının Ocak sütunun 7. satırına, Karne dosyasından N2 hücresindeki değeri al demek..

Örneğin; 8. satıra M2 hücresini almak için, üstteki kod satırının hemen altına bu kodu ilave edersiniz;
.Cells(8, i) = Range("M2").Value

 

[sacid55]

bir de : karne dosyasında ay sütunu 4.ay a geldiğinde tüm gösterge kartlarında " ilk çeyrek " hücresine rakam ekliyor. halbuki nisan sütununa eklemesi lazım

 

[Murat OSMA]

If yazan satırı bu şekilde değiştirip deneyiniz;

If Replace(Replace(LCase(.Cells(5, i)), "İ", "i"), "i", "ı") = LCase(VBA.MonthName(Range("B2").Value, False)) Then

 

[sacid55]

If yazan satırı bu şekilde değiştirip deneyiniz;

If Replace(Replace(LCase(.Cells(5, i)), "İ", "i"), "i", "ı") = LCase(VBA.MonthName(Range("B2").Value, False)) Then

olmadı hocam.. tablodaki renkli sütunlar toplamlı formül olan sütunlar. makronun o sütunları atlaması gerekiyor...

 

[Murat OSMA]

Kodları bu şekilde değiştirip dener misiniz ?

Eğer 5.satırdaki hücrenin rengi turuncu değilse satırını ilave ettim.. If .Cells(5, i).Interior.ColorIndex <> 40 Then

Option Compare Text
Sub Emre()
    Dim i As Integer, Rky As Workbook
    Application.ScreenUpdating = False
    Set Rky = Workbooks.Open(ThisWorkbook.Path & "\karne.xlsx")
    With ThisWorkbook.Sheets(1)
        For i = 6 To 22
            If .Cells(5, i).Interior.ColorIndex <> 40 Then
                If Replace(Replace(LCase(.Cells(5, i)), "İ", "i"), "i", "ı") = _
                    LCase(VBA.MonthName(Range("B2").Value, False)) Then
                    .Cells(7, i) = Range("N2").Value
                End If
            End If
        Next i
    End With
    Rky.Close False
    Application.ScreenUpdating = True
End Sub

 

[sacid55]

"renk turuncu ise" değil de "herhangi bir renk yoksa" komutu kullansak ne yazmalıyız?
diğer sayfalarda farklı renkler var da...

 

[Murat OSMA]

İpucu: Sayfanın kod kısmına şu kodu yapıştırın ve renkli olan bir hücreyi seçin.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    MsgBox Target.Interior.ColorIndex
End Sub

O hücrenin renk kodunu öğrenmiş olacaksınız.

Buna göre eğer bu renk yoksa şu renk yoksa diyebilirsiniz.

Ya da renk olmayan beyaz olan bir hücreyi seçip renk kodunu öğrendikten sonra bu satırı;
If .Cells(5, i).Interior.ColorIndex = Renk Kodu Then şeklinde kullanabilirsiniz.

 

[sacid55]

karne dosyasında ay ı 5 yaptığımda mayıs sütununa veri giriyor fakat ay ı 4 yaptığımda nisan sütununa veri eklemiyor

 

[Murat OSMA]

Son olarak...

Option Compare Text
Sub Emre()
    Dim i As Integer, Rky As Workbook
    Application.ScreenUpdating = False
    Set Rky = Workbooks.Open(ThisWorkbook.Path & "\karne.xlsx")
    With ThisWorkbook.Sheets(1)
        For i = 6 To 22
            If .Cells(5, i).Interior.ColorIndex <> 40 And Replace(Replace(UCase(.Cells(5, i)), "İ", "i"), "I", "İ") = _
                Replace(Replace(Replace(UCase(VBA.MonthName(Range("B2").Value, False)), "İ", "i"), "ı", "I"), "I", "İ") Then
                .Cells(7, i) = Range("N2").Value
            End If
        Next i
    End With
    Rky.Close False
    Application.ScreenUpdating = True
End Sub

 

[sacid55]

teşekkürler... bu sefer oldu...