Sayfalardan veri aktarımı

[Mx@Raid]

Arkadaşlar elimdeki dosyada 01, 02, 03 ... 60... olarak giden sayfalar var. Amacım bu sayfalardaki aynı hücreleri alt alta DATA sayfasına yazdırmak. Örneğin DATA sayfasının A1 hücresinden itibaren 01,02,03 ... 60 ... sayfalarındaki A1 hücresini yazdırmak. Basit bir örnek ekliyorum yardımcı olursanız sevinirim. Teşekkürler.

 

[Orion1]

Dosyanız ekte.
2ci sayfadan itibaren a1 hücrelerini ekler.

Sub a1_hucrelerini_ekle()
Dim i As Long, sat As Long
Sheets("DATA").Select
Application.ScreenUpdating = False
Range("A:A").ClearContents
For i = 2 To Worksheets.Count
    sat = sat + 1
    Cells(sat, "A").Value = Sheets(i).Range("A1").Value
Next i
Cells(sat, "A").Select
Application.ScreenUpdating = True
MsgBox "A1 Hücreleri aktarıldı..", vbOKOnly + vbInformation, "Evren GİZLEN"
End Sub

 

[Mx@Raid]

Sn. Evren bey sizin kullandığınıza benzer yöntemle çözdüm. Sizin kullandığınız yöntemi de saklıyorum ileride gerekir diye. Ancak yine bir soruna takıldım. Hcr1... Hcr8 şeklinde tanımladığım adreslerden veri karşılaştırmasını yapıp sayfaya çekmem lazım. Tek alan olursa kabul ediyor.

Private Sub WorkSheet_SelectionChange(ByVal Target As Range)

    Dim i As Long
'    Dim Hcr$(8)

'    Hcr$(1) = Sheets(sn).Range("J11:J17")
'    Hcr$(2) = Sheets(sn).Range("Z11:Z17")
'    Hcr$(3) = Sheets(sn).Range("J24:J31")
'    Hcr$(4) = Sheets(sn).Range("Z24:Z31")
'    Hcr$(5) = Sheets(sn).Range("J38:J48")
'    Hcr$(6) = Sheets(sn).Range("Z38:Z48")
'    Hcr$(7) = Sheets(sn).Range("J55:J64")
'    Hcr$(8) = Sheets(sn).Range("Z55:Z64")
    
        For sn = 5 To Worksheets.Count
        
            Range("E" & sn - 2) = Sheets(sn).Range("C18").Value
            Range("F" & sn - 2) = Sheets(sn).Range("S20").Value
            Range("G" & sn - 2) = Sheets(sn).Range("C34").Value
            Range("H" & sn - 2) = Sheets(sn).Range("S34").Value
            Range("I" & sn - 2) = Sheets(sn).Range("C51").Value
            Range("J" & sn - 2) = Sheets(sn).Range("S51").Value
            Range("K" & sn - 2) = Sheets(sn).Range("C67").Value
            Range("L" & sn - 2) = Sheets(sn).Range("S67").Value


            Set Hcr = Sheets(sn).Range("Z24:Z31")
            Range("M" & sn - 2) = WorksheetFunction.CountIf(Hcr, "FF")
    
    Next

    
    Range("D8") = WorksheetFunction.CountIf(Range("D3:D7"), "K")
    Range("D9") = WorksheetFunction.CountIf(Range("D3:D7"), "E")
    Range("D10") = Range("D8") + Range("D9")

    Range("M8") = WorksheetFunction.CountIf(Range("M3:M7"), ">0")
    Range("M9") = WorksheetFunction.CountIf(Range("M3:M7"), "1")

    Range("M10") = WorksheetFunction.CountIf(Range("M3:M7"), "2")
    Range("M11") = Range("M8") - Range("M9") + Range("M10")
    
    Range("N8") = WorksheetFunction.CountIf(Range("N3:N7"), "TAMAM")
    Range("N9") = WorksheetFunction.CountIf(Range("N3:N7"), "")
    Range("N9") = WorksheetFunction.CountIf(Range("N3:N7"), "İMZA")
    Range("N11") = Range("N8") + Range("N9") + Range("N10")
    
    Range("O8") = WorksheetFunction.CountIf(Range("O3:O7"), "İMZA")
    Range("O9") = WorksheetFunction.CountIf(Range("O3:O7"), "")
    Range("O10") = WorksheetFunction.CountIf(Range("O3:O7"), "ALMIYOR")
    Range("O11") = Range("O8") + Range("O9") + Range("O10")
    
End Sub

 

[Mx@Raid]

Arkadaşlar yardımcı olabilirseniz sevinirim.Teşekkürler.

 

[Mx@Raid]

Arkadaşlar aslında sadece belirlediğim alanlarda karşılaştırma yapmasını istiyordum. ancak cevap gelmedi. Bende aşağıdaki yolla çözdüm. İlgilenen arkadaşlara teşkkür ederim.

Set Hcr = Sheets(sn).Range("J11:Z64")
Range("M" & sn - 2) = WorksheetFunction.CountIf(Hcr, "FF")