将多个Excel工作表区域作为图片转换为新的Excel工作簿作为工作表
将多个Excel工作表区域作为图片转换为新的Excel工作簿作为工作表
提问于 2021-06-10 00:31:36
我一直在尝试将Excel工作表区域作为图片粘贴到新工作簿中作为工作表(每个区域作为不同的工作表)
代码为take Status of Col"E“如果为= Include，则其对应的工作表范围将作为图片粘贴到新工作簿。
如果为Col"E" <> Include，那么代码应该跳过这一步。在下面的图片中有3 Includes，所以代码将粘贴图片作为工作表的范围，这些范围是= Include在新工作簿的单独工作表中。
任何帮助都将不胜感激。
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回答 1
Stack Overflow用户
回答已采纳
发布于 2021-06-10 03:58:12
我将从范围中获取每个值，并将它们分别存储在一个数组中。然后使用"Sheet Name“作为主循环值，并在遍历每行时检查/使用其他列值。
工作簿和“主”工作表名称需要根据您的工作簿名称和工作表进行调整。
如下所示：
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我假设我的数据是这样的，并且所有相关的工作表都存在(即存在“包含”的工作表)。名为Book12.xlsm的工作簿：
如果我们在"Summary Dash“中有这个数据
工作表将作为图片(具有相同的工作表名称)复制到新工作簿(Book6.xlsx)。
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/67908228
复制相关文章
相似问题
腾讯云开发者
