Soru İsmi belli olmayan Excelden veri almak

[yunusemre16]

Merhaba, @veyselemre tekrardan kendisine teşekkür ederim. Bana bir makro yazdı. Başka bir örnek için yazdığından dolayı yeni örneğimde bu makroyu kullanamıyorum. Sizlerden ricam bir bakabilirmisiniz. Makronun uygulandığı EXCEL ÖRNEĞİ. Bu örnek de belirtilen yoldan dosyayı seçiyor ve oraya yazdırıyor. Ama ben bu makroyu, BU EXCELDE ki İkram ve Satılan alanlarına yazdırmak istiyorum. Yardımcı olursanız çok sevinirim.

Makro Kodu;

Sub sayfaDuzenle()
'veyselEMRE 06042019
    With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = "C:\BiletiniAl\Reports\*Büfe*Rapor*.xls"
        If .Show = -1 Then fileopen = .SelectedItems(1)
    End With

    If fileopen <> "" Then
        Set wb = Workbooks.Open(fileopen, ReadOnly:=True)
        Set sf = wb.Sheets("Sheet")

        With Intersect(sf.UsedRange, sf.Columns("G"))
            If WorksheetFunction.CountBlank(.Cells) > 0 Then
                .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
            End If
        End With
        With Intersect(sf.UsedRange, sf.Columns("F"))
            If WorksheetFunction.CountBlank(.Cells) > 0 Then
                .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
                .Value = .Value
            End If
        End With
        sf.Columns("A:E").Delete Shift:=xlToLeft
        sf.Columns("C:D").Delete Shift:=xlToLeft
        sf.Rows("1").Delete Shift:=xlToLeft
        With Intersect(sf.UsedRange, sf.Columns("B"))
            For Each huc In .Cells
                If huc.Value = "Yönetim Misafir" Then
                    huc.Value = huc.Offset(, 1).Value
                    huc.Offset(, 1).ClearContents
                Else
                    huc.Value = ""
                End If
            Next
        End With
        lst = sf.UsedRange
        wb.Close False
    End If
    With CreateObject("Scripting.Dictionary")
        Dim w(1 To 1, 1 To 2)
        For i = LBound(lst) To UBound(lst)
            ky = lst(i, 1)
            If Not .exists(ky) Then .Item(ky) = w
            y = .Item(ky)
            If lst(i, 2) <> "" Then y(1, 1) = lst(i, 2)
            If lst(i, 3) <> "" Then y(1, 2) = lst(i, 3)
            .Item(ky) = y
        Next i
        son = Cells(Rows.Count, 1).End(3).Row
        Range("B2:G" & son).ClearContents
        For i = 2 To son
            ky = Cells(i, 1).Value
            If .exists(ky) Then
                Cells(i, 2).Resize(, 2).Value = .Item(ky)
                .Remove ky
            End If
        Next i
        If .Count > 0 Then
            kys = .keys
            itm = .items
            [E2].Value = "Hatalı Kayıtlar"
            For i = LBound(kys) To UBound(kys)
                Cells(i + 3, "E").Value = kys(i)
                Cells(i + 3, "F").Resize(, 2).Value = itm(i)
            Next i
        End If
    End With
    Columns.AutoFit
    Application.Speech.Speak ("OK")
End Sub