Soru Kapalı Dosyadan Veri Almak

[Korhan Ayhan]

Deneyiniz.

[

Sorgu = "Select * From [" & Sheets("Ebat Listesi").Range("A1").Value & "$" & Veri_Adresi(X) & "]"

 

[ormann]

Korhan bey çok teşekkür ederim.Yardımlarınız için .Bu koddan farklı olarak ekli dosyada aşağıdaki makro ile aktar butonuna bastığımızda veriler masaüstüne Ebat listesi Klasörü olarak kayıt yapılıyor.Ve Bu dosyanın içerisine veri girişi sayfasındaki J8 hücresindeki isimle dosya kayıt yapılıyor. Ve bu dosyanın içerisine G18:V18 hücre aralığındaki girilen emvallar boyuna,adedine ve çapına göre sınıflandırılarak istifEbatExcel sayfası olarak aktarılıyor.Benim istediğim bu aktarılan verilerin tekrar aynı yerlerine veri al butonu ile geri alınması .Bu şekilde de veri alma olabilir mi ?

İndir EBAT LİSTESİ PROGRAMI

Dosyayı indir EBAT LİSTESİ PROGRAMI

dosya.co

Sub ORBİS()
Set S1 = Sheets("VERİ GİRİŞİ")
Set S2 = Sheets("istifEbatExcel")

eski = WorksheetFunction.Max(2, S2.Cells(Rows.Count, "A").End(3).Row)
S2.Range("A2:D" & eski).ClearContents
For cap = 20 To 99
    For boy = 7 To 22 Step 1
        If S1.Cells(cap, boy) > 0 Then
            yeni = S2.Cells(Rows.Count, "A").End(3).Row + 1
            S2.Cells(yeni, "A") = S1.[J8]
            S2.Cells(yeni, "B") = S1.Cells(cap, "F")
            S2.Cells(yeni, "C") = S1.Cells(18, boy)
            S2.Cells(yeni, "D") = S1.Cells(cap, boy)
            S2.[E1] = S1.[J10]
        
        End If
    Next
Next

MsgBox yeni - 1 & " Adet Veri aktarıldı ve  " & S1.Range("j8").Value & " İstif Nolu Dosyanız Masaüstünde EBAT LİSTESİ Klasörüne Kaydedildi", vbInformation
Dosyala

End Sub
Sub Dosyala()
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
Dim S1 As Worksheet, S2 As Worksheet
Set S1 = ThisWorkbook.Sheets("VERİ GİRİŞİ")
Set S2 = ThisWorkbook.Sheets("istifEbatExcel")
Dim yol As String, isim As String, klasor As String, Dosya As String

    yol = Environ("USERPROFILE") & "\Desktop"
    klasor = yol & "\EBAT LİSTESİ"
 If Dir(klasor, vbDirectory) = "" Then
                Shell ("cmd /c mkdir """ & klasor & """")
End If
    isim = klasor & "\İSTİF NO=" & S1.Range("J8").Value & ".xlsx"
    Dosya = isim
    S2.Cells.Copy
    Workbooks.Add (xlWBATWorksheet)
    ActiveWorkbook.ActiveSheet.Paste
    ActiveWorkbook.ActiveSheet.Name = "istifEbatExcel"
    ActiveWorkbook.SaveAs Filename:=Dosya
    ActiveWorkbook.Close SaveChanges:=True
    Application.ScreenUpdating = 1
Application.DisplayAlerts = 1
  
End Sub