Farklı excel dosyasından veri çekme

[kesikbey]

Uzman arkadaşlar..

Microsoft excel virgülle ayrılmış değerler dosyası (.CSV) olan

1 çalışma kitabındaki verileri

2 microsoft excel xls.
çalışma kitabına çekmek mümkün mü acaba?

 

[Orion1]

Dosyanız ektedir.

Sub aktar_59()
Dim sat As Long, deg, a As Integer, i As Integer, x
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Range("A2:X" & Rows.Count).ClearContents
sat = 2
Open (ThisWorkbook.Path & "\1.CSV") For Input As #1
Do While Not EOF(1)
    Line Input #1, deg
    x = Split(deg, ";")
    For a = 0 To UBound(x)
        Cells(sat, a + 1).Value = x(a)
    Next
   sat = sat + 1
Loop
Close #1
MsgBox "Veriler Alındı." & vbLf & "evrengizlen@hotmail.com", _
vbOKOnly + vbInformation, Application.UserName
End Sub

 

[kesikbey]

Kusura bakmayın bilmeden kilitlemişim

 

[Orion1]

Cevabınız 2 nolu mesajdadır.

 

[kesikbey]

Cevabınız 2 nolu mesajdadır.

Uzman Kardeşim, çok tşkrler.
benim işimi görür.

 

[kesikbey]

Uzman Kardeşim, çok tşkrler.
benim işimi görür.

ORİON BEY KARDEŞİM,
BU VERİYE N sütünuna kadar almamız mümkün mü ordan sonrasına formül kullaansam...

 

[Orion1]

ORİON BEY KARDEŞİM,
BU VERİYE N sütünuna kadar almamız mümkün mü ordan sonrasına formül kullaansam...

Dosyanız ektedir.

Sub aktar_59()
Dim sat As Long, deg, a As Integer, i As Integer, x, sut As Integer
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Range("A1:N" & Rows.Count).ClearContents
sat = 1
Open (ThisWorkbook.Path & "\1.CSV") For Input As #1
Do While Not EOF(1)
    Line Input #1, deg
    x = Split(deg, ";")
    If UBound(x) > 13 Then
        sut = 13
        Else
        sut = UBound(x)
    End If
    For a = 0 To sut
        Cells(sat, a + 1).Value = x(a)
    Next
   sat = sat + 1
Loop
Close #1
Application.ScreenUpdating = True
MsgBox "Veriler Alındı." & vbLf & "evrengizlen@hotmail.com", _
vbOKOnly + vbInformation, Application.UserName
End Sub

 

[kesikbey]

Dosyanız ektedir.

Sub aktar_59()
Dim sat As Long, deg, a As Integer, i As Integer, x, sut As Integer
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Range("A1:N" & Rows.Count).ClearContents
sat = 1
Open (ThisWorkbook.Path & "\1.CSV") For Input As #1
Do While Not EOF(1)
    Line Input #1, deg
    x = Split(deg, ";")
    If UBound(x) > 13 Then
        sut = 13
        Else
        sut = UBound(x)
    End If
    For a = 0 To sut
        Cells(sat, a + 1).Value = x(a)
    Next
   sat = sat + 1
Loop
Close #1
Application.ScreenUpdating = True
MsgBox "Veriler Alındı." & vbLf & "evrengizlen@hotmail.com", _
vbOKOnly + vbInformation, Application.UserName
End Sub

Orion Kardeşim geç oldu ama çok tşkrler, eklediğiniz kodlar işimi gördü... selamlar.

 

[kesikbey]

veri çekme

Uzman arkadaşım, aldığım verileri Bsutunundan başlasın;
Yani A sütunu boş kalsın, aynı zamanda isimler C sutunununa denk gelsinistiyorum ama bir türlü yapamadım. Mümkünse bir yardım daha...Selamlar...

 

[Orion1]

Uzman arkadaşım, aldığım verileri Bsutunundan başlasın;
Yani A sütunu boş kalsın, aynı zamanda isimler C sutunununa denk gelsinistiyorum ama bir türlü yapamadım. Mümkünse bir yardım daha...Selamlar...

Buyurun kırmızı yerleri değiştirdim.

Application.ScreenUpdating = False
[B][COLOR="Red"]Range("B1:O" & Rows.Count).ClearContents[/COLOR][/B]
sat = 1
Open (ThisWorkbook.Path & "\1.CSV") For Input As #1

For a = 0 To sut
       [B][COLOR="Red"] Cells(sat, a + 2).Value = x(a)[/COLOR][/B]
Next

If UBound(x) > 13 Then
       [B][COLOR="Red"] sut = 14[/COLOR][/B]
         Else

 

[kesikbey]

Buyurun kırmızı yerleri değiştirdim.

Application.ScreenUpdating = False
[B][COLOR="Red"]Range("B1:O" & Rows.Count).ClearContents[/COLOR][/B]
sat = 1
Open (ThisWorkbook.Path & "\1.CSV") For Input As #1

For a = 0 To sut
       [B][COLOR="Red"] Cells(sat, a + 2).Value = x(a)[/COLOR][/B]
Next

If UBound(x) > 13 Then
       [B][COLOR="Red"] sut = 14[/COLOR][/B]
         Else

hocam çok tşk ederim. Allah senden razı olsun...
Selamlar İyi geceler...