簡體   English   中英

將多個 Excel 工作表范圍作為圖片轉換為新的 Excel 工作簿作為工作表

[英]Convert Multiple Excel Sheet Ranges as Picture to New Excel Workbook as worksheets

我一直在嘗試將 Excel 工作表范圍作為圖片粘貼到新工作簿作為工作表(每個范圍作為不同的工作表)

該代碼采用 Col"E" 的狀態,如果它是 = Include,則其相應的工作表范圍將作為圖片粘貼到新工作簿。

如果Col"E" <> Include那么代碼應該跳過這個。 下圖中有3 Includes ,因此代碼會將圖片粘貼為該工作表的范圍,即= Include在新工作簿的單獨工作表中。

任何幫助將不勝感激。

https://i.stack.imgur.com/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

我會從范圍中獲取每個值並將它們分別存儲在一個數組中。 然后使用“工作表名稱”作為主循環值,並在我遍歷每一行時檢查/使用其他列值。

工作簿和“主”工作表名稱需要調整為您的工作簿名稱和工作表。

像這樣的東西:

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

在此處輸入圖像描述

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM