bilgi aktarma

[hkose61]

arkadaşlar eylül sayfasındaki bilgileri (J7 den AO 67 ye kadar) sayfa1 deki formata uygun şekilde aktar düğmesine tıkladığımda yeni bir sayfaya yada bilgisayarım C ye aktarmasını istiyorum.yardımcı olabilirseniz çok sevinirim

 

[Mustafa MUTLU]

Yedek almak istiyorsunuz sanırım.

Şu kodu denermisiniz.
C : ye Tarih ve saat ismi ile yedek alıyor.

Bir Modüle yapıştırın sayfaya koyacağınız bir düğmeye bu makroyu atayın deneyin bakalım..

Sub Aktar()
Set ds = CreateObject("Scripting.FileSystemObject")
    If MsgBox("Yedek alınacak onaylıyor musunuz ?", vbCritical + vbYesNo, "Mustafa MUTLU") = vbYes Then
    Dim Yedek As String
    Trh = Replace(Now, ":", "_")
    Kyt = "C:\"
    ThisWorkbook.Save
    ds.CopyFile ThisWorkbook.FullName, Kyt & Trh & ".xls"
    MsgBox "Yedek alma işlemi tamamlanmıştır.", vbInformation, "Mustafa MUTLU"
    Else
    MsgBox "Yedek alma işlemi iptal edilmiştir.", vbInformation, "Mustafa MUTLU"
    End If
End Sub

 

[hkose61]

dosyayı düzenleyip ekledim

 

[hkose61]

mustafa mutlu hocam ilginiz için teşekkür ederim ama ben yedek alırken eylül ayındaki bilgileri sayfa 1 deki formata uygun olarak almasını yani eylül ayındaki günlerde yazılı olan rakamların ve T.C numaralarının aktarılmasını (J7 den AO 67 ye kadar) istiyorum

 

[hkose61]

derdime bi çare

 

[omerceri]

Kodlar aşağıda

   Sheets("eylül").Select
    Sheets("eylül").Copy After:=Sheets(Sheets.Count)
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets(Sheets.Count).Select
    Application.CutCopyMode = False
    Sheets(Sheets.Count).Move
    ChDir "D:\"
    ActiveWorkbook.SaveAs Filename:="D:\eylül.xls", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close

 

[hkose61]

ömerceri hocam kodu kopyaladım yapıştırdım ama çalıştıramadım.butonu aktif hale getiremedim nasıl yapılacağı hakkında yardımcı olabilirmisiniz

 

[hkose61]

bi şeyler yapmaya çalıştım ama olmadı gibi aynı sayfayı kopyalıyor ben sayfa 1 deki formata uygun olarak almasını yani eylül ayındaki günlerde yazılı olan rakamların ve T.C numaralarının aktarılmasını (J7 den AO 67 ye kadar) istiyorum

 

[hkose61]

uygun bir kod bulup çalıştırdım doğru yeri kopyalıyor ama sayfa1 e yapıştırırken A2 den başlayarak boş olan satırları gizleyerek sadece rakamları yapıştırabilir mi acaba

Private Sub CommandButton1_Click()
Dim kopyala() As Variant
For a = 0 To 4
kopyala = Array("g7:an67")
Sheets("eylül").Range(kopyala(a)).Copy
Sheets("Sayfa1").Range(kopyala(a)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next
Application.CutCopyMode = False
End Sub

 

[hkose61]

bu kodda nereye yapıştırılacağını gösteren yer neresidir bunu söyleyebilecek kimse yok mu

 

[hkose61]

konu güncel yukarıdaki kod kopyalayıp sayfa 1 e yapıştırıyor ama a2 den başlamıyor.a2 den nasıl başlatabilirim şimdiden teşekkürler

 

[LORINSER]

Sub Ambar_Yeri_Kontrol()
'
' Ambar_Yeri_Kontrol Makro
'
dds = InputBox("Lütfen Ambar Başlangıç Numarasını Giriniz" & Chr(10) & "ör: 1010/100", , 5000, 4000)
ddf = InputBox("Lütfen Ambar Bitiş Numarasını Giriniz" & Chr(10) & "Başlangıç Numarası : " & dds, 5000, 4000)
'
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "ODBC;DSN=Autoline ODBC;UID=fisse-15;;SERVER=172.16.9.17,790;DBNAME=birollar;LUID=fisse-15;" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandText = Array( _
        "SELECT SM_10_StockFile.PartNumber, SM_10_StockFile.Description002, SM_10_StockFile.BinLocation001, SM_10_StockFile.TotalStockQuantity, SM_10_StockFile.DateLastPurchased" & Chr(13) & "" & Chr(10) & "FROM SM_10_StockFile SM_10_Sto" _
        , _
        "ckFile" & Chr(13) & "" & Chr(10) & "WHERE (SM_10_StockFile.TotalStockQuantity>=1) AND (SM_10_StockFile.BinLocation001>='" & dds & "') AND (SM_10_StockFile.BinLocation001<='" & ddf & "')" & Chr(13) & "" & Chr(10) & "ORDER BY SM_10_StockFile.BinLocation001" _
        )
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Tablo_Ambar_yeri_sorgu_1"
        .Refresh BackgroundQuery:=False
        'başlıklar
    Range("A1").RowHeight = 16
    Range("A1") = "Parça Numarası"
    Range("B1") = "Parça Adı"
    Range("C1") = "A.Yeri"
    Range("D1") = "Adet"
    Range("E1") = "Son Giriş Tarihi"
        End With
        
        Set ds = CreateObject("Scripting.FileSystemObject")
    If MsgBox("Yedek alınacak onaylıyor musunuz ?", vbCritical + vbYesNo, "Mustafa MUTLU") = vbYes Then
    Dim Yedek As String
    Trh = Replace(Now, ":", "_")
    Kyt = "C:\Users\odbc.BIROLLAR\Desktop\starorder"
    ThisWorkbook.Save
    ds.CopyFile ThisWorkbook.FullName, Kyt & Trh & ".xlsx"
    MsgBox "Yedek alma işlemi tamamlanmıştır.", vbInformation, "Mustafa MUTLU"
    Else
    MsgBox "Yedek alma işlemi iptal edilmiştir.", vbInformation, "Mustafa MUTLU"
    End If
End Sub

Dosya yoluna "starorder17.07.2013 21_39_36.xlsx" olarak dosyayı kaydediyor. Fakat dosya açılmıyor uzantısı farklı diyor. Yanlış olan nedir ?