1

I have been trying to paste the Excel Sheet ranges as Picture to the New Workbook as worksheets (Each Range as different worksheet)

The code is take the Status of Col"E" If it is = Include then its corresponding sheets ranges will be pasted as picture to New Workbook.

If Col"E" <> Include then code should skip this. There are 3 Includes in below picture so the code will paste picture as ranges of that Sheets which are = Include in there separate sheets of new workbook.

any help will be appreciated.

https://i.sstatic.net/OV3af.png

Sub SelectSheets_Ranges() Dim sh As Worksheet, lastR As Long, rng As Range, arr, arrSplit, i As Long, k As Long Set sh = ActiveSheet lastR = sh.Range("A" & sh.rows.count).End(xlUp).row ReDim arr(lastR - 1) For i = 2 To lastR If sh.Range("E" & i).value = "Include" Then arr(k) = sh.Range("C" & i).value & "|" & sh.Range("D" & i).value: k = k + 1 End If Next i ReDim Preserve arr(k - 1) For i = 0 To UBound(arr) arrSplit = Split(arr(i), "|") Set rng = Worksheets(arrSplit(0)).Range(arrSplit(1)) NewBook = Workbooks.Add Next End Sub
Improve this question
2
  • What's the specific problem you're facing? Commented Jun 9, 2021 at 17:25
  • The problem is how to add further codes to make it complete. Earlier i asked same questions and i strive to change PDF to Excel but it seems like impossible. that's why posted here. Commented Jun 10, 2021 at 10:56

1 Answer 1

Reset to default
1

I would take each value from the range and store them in an array separately. Then use the "Sheet Name" as main loop value and check/use the other column values as I loop through each rows.

Workbook and "main" sheet name need to be adjusted to your workbook name and worksheet.

Something like this:

Option Explicit Sub copy_and_paste_as_picture() Dim wb As Workbook, wb_new As Workbook Dim sheetMain As Worksheet Dim lastR, i, k As Long Dim arr As Variant Set wb = ThisWorkbook 'Set name of the master workbook Set sheetMain = wb.Worksheets("Sheet1") 'Set name of the main sheet lastR = sheetMain.Range("C" & sheetMain.Rows.Count).End(xlUp).Row 'Find last row arr = sheetMain.Range(sheetMain.Cells(6, "C"), sheetMain.Cells(lastR, "E")).Value 'Import range to array Set wb_new = Workbooks.Add 'Add a new workbook For i = LBound(arr, 1) To UBound(arr, 1) 'Loop through array If arr(i, 3) = "Include" Then 'If Status is include then wb_new.Sheets.Add(After:=Sheets(Sheets.Count)).Name = arr(i, 1) 'Add new worksheet to the new workbook with the selected name With wb.Worksheets(arr(i, 1)).Range(arr(i, 2)) 'Select range to copy .CopyPicture xlScreen, xlBitmap wb_new.Sheets(arr(i, 1)).Range("A1").PasteSpecial 'Paste as picture End With End If Next i End Sub

I assume my data looks like this and all the relevant sheets exists (i.e. sheets where "included" exists). Workbook named to Book12.xlsm:

enter image description here

If we have this data in "Summary Dash"

enter image description here

the worksheet will be copied to the new workbook (Book6.xlsx) as a picture (with same sheet name).

enter image description here

Improve this answer
Sign up to request clarification or add additional context in comments.

7 Comments

That's great to have the solution. I would like to add one thing that is the code goes for just 1st sheet and do not follow the loop and other "Includes" except 1st sheet. and the Col"C', "D" and "E" start from row no 6
Now issue is that when i run the code where Col"E" = "includes" so there 9 sheets are = include but this code just open first sheet as picture to new workbook. Does not open the remaining. @Wizhi
Happy we are progressing :). Is the status named "Include" or "includes" or "include", we could change that in code to include all the names. The code is case-sensitive and word needs to be exact. If you want to check this is my setup in excel. The Sheet Name needs also to be exact.
I think the problem is all the sheets are hidden and protected with password thats why your code just works for the first sheet not for all.
Oki, I tried to adjust the code a bit more, you have some special setup with your range and it's not very clear in the question :P. See if it works with the hidden sheets. should work otherwise we can adjust it.
|