Forum Discussion

Ramakantab15's avatar
Ramakantab15
Copper Contributor
Aug 24, 2021
Solved

cannot get the image extracted in the VBA code

Can somebody help me get corrected in the VBA code in which I need to extract data from various worksheet in a folder with similar content and stack files row by row in the output file....
this code of mine works well for letters, but for picture it is not working.
Please help.

 

Code is as below:

 

Sub getDataFromWbs()

Dim wb As Workbook, ws As Worksheet
Set fso = CreateObject("Scripting.FileSystemObject")

Dim FO As FileDialog

Set FO = Application.FileDialog(msoFileDialogFolderPicker)
FO.AllowMultiSelect = False
FO.Show
FL = FO.SelectedItems(1)

Set Fldr = fso.GetFolder(FL)

y = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1

For Each wbFile In Fldr.Files

If fso.GetExtensionName(wbFile.Name) = "xlsx" Then

Set wb = Workbooks.Open(wbFile.Path)

For Each ws In wb.Sheets
wsLR = ws.Cells(Rows.Count, 1).End(xlUp).Row

ThisWorkbook.Sheets("Sheet1").Cells(y, 1) = ws.Range("J5")
ThisWorkbook.Sheets("Sheet1").Cells(y, 2) = ws.Range("AK4")
ThisWorkbook.Sheets("Sheet1").Cells(y, 3) = ws.Range("B9")
ThisWorkbook.Sheets("Sheet1").Cells(y, 4) = ws.Range("AD19:AJ23").CopyPicture
y = y + 1
Next ws
wb.Close
End If

Next wbFile
Set FO = Nothing

End Sub

4 Replies

  • Ramakantab15 

    As you have found, this will not work, but I am confused. You're trying to copy a picture or pictures from a range consisting of 5 rows (19 to 23) to a single row (y).

    Wouldn't that cause problems?

Resources