Aktarım programı hk.

[van_65166]

Üstatlar merhaba

Ben boyumdan büyük bir projeye kalkıştım siz değerli üstatlarımın yardımı olmadan başaramayacağım.
Bana bağlı Türkiye genelinde 300 dükkan var bunların kullandığı tek tip asıl adında bir excel dosyası var
Ben ayda bir defa onlara başka bir excel dosyasında veri gönderiyorum ama her dükkana giden excel tablosu aynı fakat verisi varklı
Dükkanlar benim gönderdiğim veriyi ilgili tablolara yapıştırıyorlar. Fakat çoğu dükkan yanlış yere yapıştırdığı için akşam raporları yanlış geliyor
yanlış gelen raporu tespit edemiyorum.

Sizden istediğim ekte gönderdiğim 2 dosyada vba yardımı ile aktar dosyasındaki verileri asıl dosyasının içinde ilgili tabloya yapıştırması
yani ben aktar dosyasını mail attığımda onlar bir butona basıp ilgili veriler doğru yerlerine yapışsın ondan sonra zaten aktar dosyasının işi bitiyor.

Aktar dosyasında Toplam 4 tablo var

bunlar;
MS tablosu asıl Dashborad içinde CM18-CY49 hücre aralığına
KA tablosu asıl Dashborad içinde DA53-DM84 hücre aralığına
ST tablosu asıl Dashborad içinde T88-AF119 hücre aralığına
FS tablosu asıl Dashborad içinde DA17-DM49 hücre aralığına yerleşmesi gerekiyor.

Ayrıca tabloda boş olan hücrelerin yerine "0" değeri bırakması gerekli ayrıca olmayan ayların yerinede yine 0 olması gerekiyor kısacası tabloda boş hücre olmaması gerekiyor

Mesela önümüzdeki ayda güncel verileri gönderirsem aynı yerlere aktarırmı yoksa her ay yapmamız gerekirmi

Saygılarımla

AKTAR DENEME.xlsx

drive.google.com

ASIL DENEME.xlsx

drive.google.com

 

[mancubus]

kaynak dosya: AKTAR
hedef dosya: ASIL

kaynak dosyadaki veriler değişiyorsa, her değişiklik sonrası çalıştırılabilir.

hedef dosyada Ay adları ve gün sıra numaraları zaten mevcut olduğundan, aktarmaya dahil edilmedi. bir de 0'lar boş görünsün olarak seçili sanırım. o nedenle hücre formatını da koda dahil ettim.

kodu üçüncü bir xlsm dosyanın kod modülüne kopyalayın ve çalıştırırken AKTAR ve ASIL dosyalarının açık olmasına dikkat edin.

çok ilgisi olmamakla birlikte belirtmeden geçemedim:
bilgisayar programlarında, dosyalarda, sunumlarda, vs vs çok yaygın olduğu için artık Türkçe olarak ta kabul edebileceğimiz dashboARd kelimesini ya bu şekilde yazın (dashboRAd değil yani) ya da yine Türkçe'mize girmiş panel kelimesini kullanın.
kumanda paneli de olabilir belki.
Türkçe'deki tam karşılığı olan "gösterge paneli" genellikle arabada sürücü koltuğuna oturduğumzda karşımızda olan panel olarak yerleştiğinden tercih edilmeyebilir.

 

[mancubus]

Sub xlTR_193188_veri_aktar()

    Dim wb As Workbook, ws As Worksheet
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    Set wb = Workbooks("AKTAR DENEME.xlsx")
    Set ws = Workbooks("ASIL DENEME.xlsx").Worksheets("Dashboard")
    
    With ws.Range("CN19:CY49")
        .Value = wb.Worksheets("MS").Range("B7:L37").Value
        .SpecialCells(xlCellTypeBlanks).Value = 0
        .NumberFormat = "#,##0"
    End With

    With ws.Range("DB54:DM84")
        .Value = wb.Worksheets("KA").Range("B7:L37").Value
        .SpecialCells(xlCellTypeBlanks).Value = 0
        .NumberFormat = "#,##0"
    End With
    
    With ws.Range("U89:AF119")
        .Value = wb.Worksheets("ST").Range("B6:L36").Value
        .SpecialCells(xlCellTypeBlanks).Value = 0
        .NumberFormat = "#,##0"
    End With
    
    With ws.Range("DB19:DM49")
        .Value = wb.Worksheets("FS").Range("B6:L36").Value
        .SpecialCells(xlCellTypeBlanks).Value = 0
        .NumberFormat = "#,##0"
    End With

    With Application
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With

End Sub

 

[mancubus]

2nci bir versiyon olarak Range değişkenleri ile de halledilebilir.
(dizi değişkeni kullanmak ta mümkündü tabii.)

Sub xlTR_193188_veri_aktar_2()

    Dim rngMS As Range, rngKA As Range, rngST As Range, rngFS As Range
    Dim rngCN19 As Range, rngDB54 As Range, rngU89 As Range, rngDB19 As Range
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    With Workbooks("AKTAR DENEME.xlsx")
        Set rngMS = .Worksheets("MS").Range("B7:L37")
        Set rngKA = .Worksheets("KA").Range("B7:L37")
        Set rngST = .Worksheets("ST").Range("B6:L36")
        Set rngFS = .Worksheets("FS").Range("B6:L36")
    End With
    
    With Workbooks("ASIL DENEME.xlsx")
        Set rngCN19 = .Worksheets("Dashboard").Range("CN19:CY49")
        Set rngDB54 = .Worksheets("Dashboard").Range("DB54:DM84")
        Set rngU89 = .Worksheets("Dashboard").Range("U89:AF119")
        Set rngDB19 = .Worksheets("Dashboard").Range("DB19:DM49")
    End With
    
    With rngCN19
        .Value = rngMS.Value
        .SpecialCells(xlCellTypeBlanks).Value = 0
        .NumberFormat = "#,##0"
    End With

    With rngDB54
    .Value = rngKA.Value
    .SpecialCells(xlCellTypeBlanks).Value = 0
        .NumberFormat = "#,##0"
    End With
    
    With rngU89
        .Value = rngST.Value
        .SpecialCells(xlCellTypeBlanks).Value = 0
        .NumberFormat = "#,##0"
    End With
    
    With rngDB19
        .Value = rngFS.Value
        .SpecialCells(xlCellTypeBlanks).Value = 0
        .NumberFormat = "#,##0"
    End With

    With Application
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With

End Sub

 

[mancubus]

ben sayfa ismini "dahsboard" olarak yazdım. siz "dashborad" olarak kullanmaya devam edecekseniz koddaki sayfa isimlerinde değişiklik yapın .