hücreye sayfa komutu verme

[idealimsin]

merhaba
koray arkadaşım asıl dosyamla ek te verdiğim dosya arasında bir farkyok.ayni tablo ve bendeki sadece fazla sayfalı bir dosya.şu işide halletsem sorunum 4 * 4lük hallolmuş olacak.bir zahmet arkadaşım

arkadaşım bir el atıverin ...bir yola çoktım tıkandım kaldım burda

 

[idealimsin]

Acil yardım edebilecek arkadaslar

MERHABA
AŞAGIDA VERİLEN İKİ FORMÜLDE ÇAKIŞMA YADA BİR TERS GİDEN BİŞEYLER VAR GİBİ. MAKRODA "AKTAR" DEDİĞİMİZ ZAMAN ANASAYFADA Kİ L3 HÜCRESİNİN AŞAĞISINDA VE SAĞINDA OLAN RAKAMLARI DEĞİL FORMÜLLERİ KOPYALA YAPIŞTIR YAPIYORVEYA BOŞ GÖRÜYOR.EKTEDE VAR.ASIL DOSYAMA UYGULADIĞIMDA BÖYLE YAPIYR.FORMÜLÜ DEĞİLDE TEXT Tİ OKUTABİLİRMİYİZ.




=EĞERHATA(DÜŞEYARA($K3;DOLAYLI("'"&METNEÇEVİR($H3; "gg.aa.yyyy")&"-"&$I3&"'!C9:J1048576");SÜTUN(B$1);0);"")


sub aktar()
son = sheets("anasayfa").cells(rows.count, "h").end(3).row
for each alan ın sheets("anasayfa").range("h3:h" & son)
set sayfa = nothing
on error resume next
set sayfa = sheets(alan.text)
on error goto 0
ıf not sayfa ıs nothing then
alan.offset(0, 2).resize(1, 9).copy sheets(alan.text).range("a1")
alan.offset(0, -7).resize(1, 7).value = sheets(alan.text).range("a5:g5").value
end ıf
next

msgbox "işleminiz tamamlanmıştır.", vbınformation
end sub

 

[Mahir64]

MErhaba,

Başlığınız uygun değil, mesajınızın hepsi büyük ....

 

[Korhan Ayhan]

Merhaba,

Dosyanızda tam olarak ne yapmak istiyorsunuz. Lütfen hücre adresleri vererek tarif ediniz.

 

[idealimsin]

Merhaba,

Dosyanızda tam olarak ne yapmak istiyorsunuz. Lütfen hücre adresleri vererek tarif ediniz.

Anasayfada L3 hucresi ve saginda 9 hucrenin icindeki formulu okumadan
Ustundeki degeri ( text rakamları) makro daki "aktar" ı calistirabilmek.normalde simdi su haliyle "aktar" L3 ve sagindaki dokuz hucrenin formulunu kopyaliyor

 

[Korhan Ayhan]

Dosyadaki kodun doğru çalıştığını varsayarsak aşağıdaki gibi düzenlerseniz verileri değer olarak aktarır.

Sub AKTAR()
    Son = Sheets("ANASAYFA").Cells(Rows.Count, "H").End(3).Row
    For Each Alan In Sheets("ANASAYFA").Range("H3:H" & Son)
        Set Sayfa = Nothing
        On Error Resume Next
        Set Sayfa = Sheets(Alan.Text)
        On Error GoTo 0
        If Not Sayfa Is Nothing Then
            If Sayfa.Name <> "ANASAYFA" Then
                Alan.Offset(0, 2).Resize(1, 9).Copy
                Sheets(Alan.Text).Range("A1").PasteSpecial Paste:=xlPasteValues
                Application.CutCopyMode = False
                Alan.Offset(0, -7).Resize(1, 7).Value = Sheets(Alan.Text).Range("A5:G5").Value
            End If
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[idealimsin]

çok çok teşekkür ederim arkadaşım.eline sağlık