将多个 Excel 工作表范围作为图片转换为新的 Excel 工作簿作为工作表

Question

我一直在尝试将 Excel 工作表范围作为图片粘贴到新工作簿作为工作表（每个范围作为不同的工作表）

代码取 Col"E" 的状态，如果是 = Include，则其对应的工作表范围将作为图片粘贴到 New Workbook。

如果是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

Answer 1

我会从范围中取出每个值并将它们分别存储在一个数组中。然后使用“工作表名称”作为主循环值，并在循环每一行时检查/使用其他列值。

工作簿和“主”工作表名称需要调整为您的工作簿名称和工作表。

类似这样的：

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)。