Kapalı dosyada verileri alınması hk.

[1903emre34@gmail.com]

Merhaba,

Açık dosyada muavin sayfasına;

Ana kod (kapalı dosyadan ana hesap)
Detay kod (kapalı dosyadan alt hesap),
Hesap adı (kapalı dosyadan ana hesap adı)
Tarih (kapalı dosyadan kayıt tarihi)
Fiş no (kapalı dosyada yevmiye madde no)
Açıklama (kapalı dosyada açıklama kısmı)
Bor ve alacak kısmı (kapalı dosyada borç ve alacak kısmı)
kapalı dosyada nasıl kod oluşturabiliriz?

http://s6.dosya.tc/server10/v10lng/dosya.zip.html

 

[Asri]

Aşağıdaki şekilde deneyiniz.
Kod açık dosyadaki Modul1 e yapıştırılacak.

Sub menu()
  Application.DisplayAlerts = False
    Call sayfa_kopyala
    Call kolonlari_kaydir
    Call baslik_yaz
  Application.DisplayAlerts = True
End Sub

Sub sayfa_kopyala()
    If WorksheetExists([COLOR=red]"Yevmiye Defteri"[/COLOR]) Then Sheets([COLOR=red]"Yevmiye Defteri"[/COLOR]).Delete
    If WorksheetExists([COLOR=red]"Muavin"[/COLOR]) Then Sheets([COLOR=red]"Muavin"[/COLOR]).Delete
    
    acikdosya = ActiveWorkbook.Name
    dosya = ActiveWorkbook.Path & "\[COLOR=red]Kapalı dosya.xlsx[/COLOR]"
    Workbooks.Open Filename:=dosya, UpdateLinks:=0
    kapalidosya = ActiveWorkbook.Name
    Workbooks(kapalidosya).Sheets([COLOR=red]"Yevmiye Defteri"[/COLOR]).Copy Before:=Workbooks(acikdosya).Sheets(1)
    Workbooks(kapalidosya).Close
    Sheets([COLOR=Red]"Yevmiye Defteri"[/COLOR]).Name = [COLOR=red]"Muavin"[/COLOR]
End Sub

Sub kolonlari_kaydir()
    Columns("C:C").Select
    Selection.Cut
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    
    Columns("E:E").Select
    Selection.Cut
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    
    Columns("E:E").Select
    Selection.Cut
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    
    Columns("F:F").Select
    Selection.Delete Shift:=xlToLeft
    Columns("I:I").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:G").EntireColumn.AutoFit
    Columns("H:H").EntireColumn.AutoFit
End Sub

Sub baslik_yaz()
    Range("A1").Value = "ANA KOD"
    Range("B1").Value = "DETAY KOD"
    Range("C1").Value = "HESAP ADI"
    Range("D1").Value = "TARİH"
    Range("E1").Value = "FİŞ NO"
    Range("F1").Value = "Açıklama"
    Range("G1").Value = "BORÇ"
    Range("H1").Value = "ALACAK"
End Sub


Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
   On Error Resume Next
   WorksheetExists = (Sheets(WorksheetName).Name <> "")
   On Error GoTo 0
End Function

 

[1903emre34@gmail.com]

Teşekkürler, sorunsuz aktarıldı.