• DİKKAT

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

veri aktarma

Katılım
29 Ekim 2007
Mesajlar
84
Excel Vers. ve Dili
excel 2016 tr.
merhabalar, hayırlı akşamlar.
örnek dosya veri sayfasında açıklama yaptım, veri sayfasına aktarma yaparken 1.2. ve 3. sayfadaki verilerin alt alta aktarılması lazım ama yapabildiğim kadarıyla aynı hücrelere veri aktarıyor. hatalı işlem yapıyor.
şimdiden teşekkürler.
 

Ekli dosyalar

Merhaba,
Ne açıklamanızı anladım, ne de kodda ne yaptığınızı,
 
hocam merhaba
önce 1. sayfadaki verileri veri sayfasının A3 satırından başlayarak kaydetmesi, sonra A4 satırdan itibaren 65 satıra kadar sayfa 2 deki verileri, 3-4-5 diye bu şekilde devam edecek, alt alta kaydedecek, inşallah anlatabilmişimdir,
 
... 1. sayfadaki verileri veri sayfasının A3 satırından başlayarak kaydetmesi, sonra A4 satırdan itibaren 65 satıra kadar sayfa 2 deki verileri, 3-4-5 diye bu şekilde devam edecek, alt alta kaydedecek,...
Kaydedecek derken; veriyi aktaracak mı? Örneğin "Bilg1" mi yazacak? Yoksa sizin yaptığınız gibi formül yazıp veriyi gösterecek mi? (Örneğin; "='3'!B2" mi yazacak?)
 
Anlaşılma sorunu haalaaa devam ediyor.
 
Kaydedecek derken; veriyi aktaracak mı? Örneğin "Bilg1" mi yazacak? Yoksa sizin yaptığınız gibi formül yazıp veriyi gösterecek mi? (Örneğin; "='3'!B2" mi yazacak?)
aktaracak yani "bilgi1" yazacak, ben daha sade bir örnek hazırlayıp ekleyeyim,
 
Merhaba,

Mantığını pek kavrayamadım ama, kodları deneyiniz derim.
Sabit Sayfasındaki verileri dikkate almadım.

Kod:
Sub Makro1()

    Dim i As Long
    Dim j As Long
    Dim syf As Worksheet
    Dim shv As Worksheet
    Dim Bolge As Variant
    
    ReDim Bolge(1 To 3, 1 To 2)
    
    Bolge(1, 1) = "İÇ_ANADOLU"
    Bolge(1, 2) = "MERKEZ"
    
    Bolge(2, 1) = "EGE"
    Bolge(2, 2) = "İLÇE"
    
    Bolge(3, 1) = "AKDENİZ"
    Bolge(3, 2) = "MERKEZ_İLÇE"
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    
    Set shv = Sheets("veri")
    shv.Range("A3").CurrentRegion.Offset(1).ClearContents
    
    For Each syf In Worksheets
        If IsNumeric(syf.Name) Then
            i = shv.Cells(Rows.Count, "A").End(3).Row + 1
            shv.Range("A" & i) = Bolge(syf.Name, 1)
            shv.Range("B" & i) = Bolge(syf.Name, 2)
            shv.Range("C" & i) = "='" & syf.Name & "'!A2"
            shv.Range("C" & i).AutoFill Destination:=shv.Range("C" & i & ":F" & i), Type:=xlFillDefault
            j = i + syf.Cells(Rows.Count, "A").End(3).Row - 2
            Range("A" & i & ":F" & j).FillDown
        End If
    Next syf
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
    
    MsgBox ":::::::::: İŞLEM TAMAMLANMIŞTIR ::::::::::"
    
End Sub
 
Son düzenleme:
İlginizden dolayı çok teşekkürler, emeğinize sağlık,
deneyip bilgi vereceğim,
 
Geri
Üst