Kapalı dosyadan verileri getirmek

[tahsinanarat]

kapalı durumda bulunan D:\Arçelik klasöründe bulunan faturalar.xlsx çalışma kitabının Sayfa1 sayfasındaki verilerden A sütununda Borç ve D sütununda APE ile başlayan satırları örnek olarak gönderdiğim ve açık olan, olmasıgereken.xlsx dosyasındaki gibi almak istiyorum. Yardımcı olacak arkadaşlarıma şimdiden teşekkür ederim.

 

[askm]

Sadece borçları mı istiyorsunuz, borç alacak bakiye kısmını mı istiyorsunuz? Örnekde sadece borçlar mevcut.

 

[tahsinanarat]

Sn. askm, a sütununda borç ve d sütununda APE ile başlayan faturaları yani iki koşullu

 

[askm]

Sub askm()
Application.ScreenUpdating = False
For i = Range("A" & Rows.Count).End(3).Row To 1 Step -1
    If Cells(i, 1) <> "Borç" And Cells(i, 1) <> "B/A" Or Left(Cells(i, 4), 3) <> "APE" Then
        Rows(i).Delete
    End If
Next i
For i = 1 To Range("A" & Rows.Count).End(3).Row
    If Cells(i, 1) = "B/A" Then
        x = x + 1
        If x > 1 Then
            Rows(i).Delete
        End If
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamam...", vbInformation, "ASKM"
End Sub

 

[tahsinanarat]

Sn. askm, sizin kodunuzu kapalı dosyadan dataları alma kodlarından sonra çalıştırdığımda istediğim sonucu hızlı bir şekilde verdi, teşekkür ederim, ancak başlık satırını sildirmemeyi başaramadım.

Sub datalarıgetir()
'
' datalarıgetir Makro
'

'
    ChDir "D:\Arçelik"
    Workbooks.Open Filename:= _
        "D:\Arçelik\Arçelikfaturaları.xlsx"
    Cells.Select
    Selection.Copy
    Windows("Arçelik_faturaları.xlsm").Activate
    Sheets("Sayfa1").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("A:A").Select
    Windows("Arçelik_faturaları.xlsm").Activate
    Application.CutCopyMode = False
    Columns("b:b").NumberFormat = "m/d/yyyy"
    Columns("f:f").NumberFormat = "m/d/yyyy"
    Windows("Arçelikfaturaları.xlsx").Activate
    ActiveWorkbook.Close
    ActiveWindow.SmallScroll Down:=-18
    Range("A1").Select
    ActiveWindow.SmallScroll Down:=3
    Range("A1").Select
    askm
End Sub

 

[askm]

For i = 1 To Range("A" & Rows.Count).End(3).Row
If Cells(i, 1) = "B/A" Then
x = x + 1
If x > 1 Then
Rows(i).Delete
End If
End If
Next i
bu kısım öncesinde başlıklar silinmiyor. Bu kısım ile de sadece ilk baştaki kalıyor sonrasındaki başlıklar siliniyor.

 

[tahsinanarat]

Sn. askm B/A ile başlayan başlık da siliniyor.