iki farklı çalışma kitabı

Katılım
16 Nisan 2007
Mesajlar
38
Excel Vers. ve Dili
2007
Elimde iki tane farklı çalışma kitabı var birincisinin ismi a diğerinin ismi b

a çalışma kitabının x sayfası y satırından
b çalışma kitabnın x sayfasının y satırını çekmek istiyorum nasıl yapabilirim
 
Katılım
16 Nisan 2007
Mesajlar
38
Excel Vers. ve Dili
2007

Ekli dosyalar

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Dosyanız ektedir.:cool:
Kod:
Sub aktar()
Dim k As Byte, i As Byte
Application.ScreenUpdating = False
Range("A13:L109").ClearContents
For i = 3 To 6
    Application.ExecuteExcel4Macro ("'" & ThisWorkbook.Path & "\[1.xls]N1- 1'!R" & i & "C10")
Next
Range("A7").Value = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[1.xls]N1- 1'!R7C1")
Range("A9").Value = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[1.xls]N1- 1'!R9C1")

For i = 13 To 109
    For k = 1 To 12
        Cells(i, k).Value = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[1.xls]N1- 1'!R" & i & "C" & k)
    Next k
Next i
Application.ScreenUpdating = True
MsgBox "Veriler alındı." & vbLf & _
vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub
 

Ekli dosyalar

Katılım
16 Nisan 2007
Mesajlar
38
Excel Vers. ve Dili
2007
Dosyanız ektedir.:cool:
Kod:
Sub aktar()
Dim k As Byte, i As Byte
Application.ScreenUpdating = False
Range("A13:L109").ClearContents
For i = 3 To 6
    Application.ExecuteExcel4Macro ("'" & ThisWorkbook.Path & "\[1.xls]N1- 1'!R" & i & "C10")
Next
Range("A7").Value = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[1.xls]N1- 1'!R7C1")
Range("A9").Value = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[1.xls]N1- 1'!R9C1")

For i = 13 To 109
    For k = 1 To 12
        Cells(i, k).Value = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[1.xls]N1- 1'!R" & i & "C" & k)
    Next k
Next i
Application.ScreenUpdating = True
MsgBox "Veriler alındı." & vbLf & _
vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub
Sayın evren çok tşk ederim

Şimdi ben ikinci bir çalışma kitabından 2 seansı çekeceğim onun için bu şekilde mi yapmam lazım

Birinci kitapta n1-1 olan burada n2-1 diğer kitaın ismi bir ken bunun 2

Sub aktar2()
Dim k As Byte, i As Byte
Application.ScreenUpdating = False
Range("A13:L109").ClearContents
For i = 3 To 6
Application.ExecuteExcel4Macro ("'" & ThisWorkbook.Path & "\[2.xls]N2- 1'!R" & i & "C10")
Next
Range("A7").Value = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[2.xls]N2- 1'!R7C1")
Range("A9").Value = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[2.xls]N2- 1'!R9C1")

For i = 13 To 109
For k = 1 To 12
Cells(i, k).Value = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[1.xls]N1- 1'!R" & i & "C" & k)
Next k
Next i
Application.ScreenUpdating = True
MsgBox "Veriler alındı." & vbLf & _
vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Kitap ve sayfa isimlerini yeni duruma göre değiştirmeniz gerekiyor.:cool:
 
Katılım
16 Nisan 2007
Mesajlar
38
Excel Vers. ve Dili
2007
Cells(i, k).Value = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[1.xls]N1- 1'!R" & i & "C" & k)

şu kısmı gözümden kaçırmışım tekrar tşk ederim
 
Katılım
16 Nisan 2007
Mesajlar
38
Excel Vers. ve Dili
2007
Çok oldum biliyorum ama ne yapayım sizler gibi henüz pratik çözüm üretemiyorum

yukarıdaki çalışmayı biaz daha özetlemek istedim a13 L109 yerine
sadece d14 L14 satırındaki değerleri çekmek istersem ve a2 ı2 ye aktarmak için kodu nasıl düzenleyebilirim
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Çok oldum biliyorum ama ne yapayım sizler gibi henüz pratik çözüm üretemiyorum

yukarıdaki çalışmayı biaz daha özetlemek istedim a13 L109 yerine
sadece d14 L14 satırındaki değerleri çekmek istersem ve a2 ı2 ye aktarmak için kodu nasıl düzenleyebilirim
deneyiniz.:cool:
Kod:
For k = 4 To 12
Cells(i, k-3).Value = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[1.xls]N1- 1'!R4C" & k)
next
 
Katılım
16 Nisan 2007
Mesajlar
38
Excel Vers. ve Dili
2007
Malesef çalıştıramadım

1 deki n1-1 deki d14 l14 verilerini
borsa sayfa 2 ye tablonun altına çekmeye çalışmadım olmadı:S
 

Ekli dosyalar

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Tablonun en altına 14 nüc satırı 110ncu satıra attım.:cool:
Dosya ektedir.:cool:
Kod:
For k = 4 To 9
    Cells(110, k).Value = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[1.xls]N1- 1'!R14C" & k)
Next
 

Ekli dosyalar

Katılım
16 Nisan 2007
Mesajlar
38
Excel Vers. ve Dili
2007
çok tşk ederim ama bişey sormak istiyorum burada kullandığınız i ve k ne anlama geliyor
 
Katılım
16 Nisan 2007
Mesajlar
38
Excel Vers. ve Dili
2007
Sub aktar()
Dim k As Byte, i As Byte
Application.ScreenUpdating = False
Range("A13:L109").ClearContents

For k = 1 To 12
Cells(3, k).Value = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[1.xls]N1- 1'!R14C" & k)
Next
Application.ScreenUpdating = True
MsgBox "Veriler alındı." & vbLf & _
vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

bu kodu 3. sütün 14 satıra yazdırmak istedim ama beceremedim


Cells([14,i], [3, k]).Value = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[1.xls]N1- 1'!R14C" & k)
 
Katılım
16 Nisan 2007
Mesajlar
38
Excel Vers. ve Dili
2007
Veri özet ile denedim uyarsa size
borsa xls

Aslında yapmak istediğim böyle bir şey fakat sadece tek hisseyyi oraya çekmek istiyorum her hisse için ayrı bir sayfa oluşturacağım çünkü

İkincisi
TSS ile biten yerden sonra ikinci seansı da oraya çekmek istiyorum

Tam olarak yapmak istediğim bu
 
Katılım
16 Nisan 2007
Mesajlar
38
Excel Vers. ve Dili
2007
zipte 3 tane dosya var

Borsa
1
2

Benim yapmak istediğim 1 deki (n1-1)ve 2 deki (n2-1) deki acı badem yazan hisseyi borsa yazılı kısma çekmek sadece o hisseyi

Umarım açıklayabilmişimdir.

Ayrıca yardımınız için her ikinize tekrar tekrar çok tşk ederim
 

Ekli dosyalar

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Dosyanız ektedir.:cool:
Kod:
Sub acibadem()
Dim k As Byte, i As Byte, sat As Long, deg As String
Sheets("ACIBD.E").Select
sat = 3
Range("A3:R65536").ClearContents
For i = 14 To 108
    deg = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[1.xls]N1- 1'!R" & i & "C3")
    If deg Like "ACIBADEM" & "*" Then
        For k = 1 To 12
            Cells(sat, k).Value = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[1.xls]N1- 1'!R" & i & "C" & k)
        Next
        sat = sat + 1
    End If
Next
For i = 14 To 108
    deg = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[2.xls]N2- 1'!R" & i & "C3")
    If deg Like "ACIBADEM" & "*" Then
        For k = 1 To 12
            Cells(sat, k).Value = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[2.xls]N2- 1'!R" & i & "C" & k)
        Next
        sat = sat + 1
    End If
Next
MsgBox "ACI BADEM akatarıldı." & vbLf & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub
 

Ekli dosyalar

Katılım
16 Nisan 2007
Mesajlar
38
Excel Vers. ve Dili
2007
Dosyanız ektedir.:cool:
Kod:
Sub acibadem()
Dim k As Byte, i As Byte, sat As Long, deg As String
Sheets("ACIBD.E").Select
sat = 3
Range("A3:R65536").ClearContents
For i = 14 To 108
    deg = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[1.xls]N1- 1'!R" & i & "C3")
    If deg Like "ACIBADEM" & "*" Then
        For k = 1 To 12
            Cells(sat, k).Value = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[1.xls]N1- 1'!R" & i & "C" & k)
        Next
        sat = sat + 1
    End If
Next
For i = 14 To 108
    deg = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[2.xls]N2- 1'!R" & i & "C3")
    If deg Like "ACIBADEM" & "*" Then
        For k = 1 To 12
            Cells(sat, k).Value = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[2.xls]N2- 1'!R" & i & "C" & k)
        Next
        sat = sat + 1
    End If
Next
MsgBox "ACI BADEM akatarıldı." & vbLf & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub
çok saol hocam ilginize çok tşk ederim
 
Üst