- Katılım
- 22 Ekim 2012
- Mesajlar
- 311
- Excel Vers. ve Dili
- Office 2016 Türkçe
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub AKTAR()
Dim K1 As Workbook, K2 As Workbook
On Error Resume Next
Set K1 = ThisWorkbook
Set K2 = Workbooks("Mizan (1).xls")
K1.Sheets("Sayfa1").Range("G11:I12").ClearContents
With K1.Sheets("Sayfa1")
.Range("G11") = WorksheetFunction.VLookup("100.01", K2.Sheets(1).Range("A:H"), 6, 0)
.Range("G12") = WorksheetFunction.VLookup("102", K2.Sheets(1).Range("A:H"), 6, 0)
.Range("H11") = WorksheetFunction.VLookup("102.02", K2.Sheets(1).Range("A:H"), 5, 0)
.Range("H12") = WorksheetFunction.VLookup("120", K2.Sheets(1).Range("A:H"), 8, 0)
.Range("I11") = WorksheetFunction.VLookup("121.01", K2.Sheets(1).Range("A:H"), 7, 0)
.Range("I12") = WorksheetFunction.VLookup("153", K2.Sheets(1).Range("A:H"), 6, 0)
End With
Set K1 = Nothing
Set K2 = Nothing
MsgBox "Veriler aktarılmıştır.", vbInformation
End Sub
Set K2 = Workbooks("[COLOR=red]Mizan (1).xls[/COLOR]")
Sub AKTAR()
Dim K1 As Workbook, K2 As Workbook
On Error Resume Next
Application.ScreenUpdating = False
Set K1 = ThisWorkbook
Set K2 = Workbooks.Open(K1.Path & "\Mizan(1).xls")
K1.Sheets("Sayfa1").Range("G11:I12").ClearContents
With K1.Sheets("Sayfa1")
.Range("G11") = WorksheetFunction.VLookup("100.01", K2.Sheets(1).Range("A:H"), 6, 0)
.Range("G12") = WorksheetFunction.VLookup("102", K2.Sheets(1).Range("A:H"), 6, 0)
.Range("H11") = WorksheetFunction.VLookup("102.02", K2.Sheets(1).Range("A:H"), 5, 0)
.Range("H12") = WorksheetFunction.VLookup("120", K2.Sheets(1).Range("A:H"), 8, 0)
.Range("I11") = WorksheetFunction.VLookup("121.01", K2.Sheets(1).Range("A:H"), 7, 0)
.Range("I12") = WorksheetFunction.VLookup("153", K2.Sheets(1).Range("A:H"), 6, 0)
End With
K2.Close False
Set K1 = Nothing
Set K2 = Nothing
Application.ScreenUpdating = True
MsgBox "Veriler aktarılmıştır.", vbInformation
End Sub