将范围内的特定单元格复制到新的工作表范围内

Question

我正在尝试构建一个 VBA 宏，它从两个不同的 table 中读取单元格并在不同的工作表中填充一个新的 table。我已经能够复制整行并移动到新的工作表，但我只想要这个新宏的特定单元格，我很难弄清楚。

我在 Sheet 上有两个 table，名为“Estimate”

材料 Table是A9:G100
劳动力 Table是I9:M100

我需要将数据复制到名为“BOM”的 Sheet

物料清单 Table 是 A9:C100

我想做的是：

First Loop:
    if A9-A100 <> ""
     Copy A, C, G
     Paste to Worksheet "BOM" into Columns A9-100:C9-100
End first loop

Second Loop:
    if I9-I00 <> ""
     Copy I, K, M
     Paste to Worksheet "BOM" AFTER the last row in the first loop
End second loop

这是我得到的代码，但经过了多次不同的迭代，所以如果有点乱请原谅我。

' BOM Generation
Sub BuildBOM()
    Dim c As Range
    Dim j As Integer
    Dim Sht As Worksheet
    Dim sheet_names As Variant

    ' Assign the source of the estimate I want to copy
    Set SourceSht = ThisWorkbook.Sheets("Estimate")
    Set TargetSht = ThisWorkbook.Sheets("BOM")
    
    ' Which Cells do I want to copy from the Estimte
    cls = Array("A", "C", "G", "I", "K", "M")
    
    ' Which Cells do I want to copy into the BOM
    dls = Array("A", "B", "C")
    
    ' What row do I start the paste on
    j = 9
    
    ' Clear the previous BOM items before creating/refreshing
    TargetSht.Rows(j & ":" & TargetSht.Rows.Count).ClearContents
    
    ' Switch to the BOM sheet
    TargetSht.Activate

    ' First loop of the Materials table
    For Each c In SourceSht.Range("A9:A100")
    
        ' Check if there's content in A column, starting the desired row
        If c <> "" Then
            'SourceSht.Rows(c.Row).Copy
            SourceSht.Range("A:A").Copy
            TargetSht.Range("A:A").PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            j = j + 1
        End If
    Next c

End Sub

希望这就足够了，但如果我遗漏了任何内容以帮助理解我正在寻找的最终结果，请务必告诉我。

如果有帮助的话，这里有一些视觉效果

谢谢！

Answer 1

您有一些未在 Sub 中声明的变量，最好始终明确声明所有变量及其类型。在您的模块顶部插入 Option Explicit 以帮助您执行此操作。

因为您的目标涉及大量读取和从一个单元格到另一个单元格的值传输。建议在数组中处理所有这些值，而不是直接从单元格处理。（Reading/writing into/from 细胞是一个非常昂贵的过程，所以越少越好）

试试下面的代码：

Option Explicit

Sub BuildBOM()
    ' Assign the source of the estimate I want to copy
    Dim SourceSht As Worksheet
    Set SourceSht = ThisWorkbook.Sheets("Estimate")
    
    Dim sourceCols() As String
    ' Which Cells do I want to copy from the Estimte
    sourceCols = Split("A,C,G,I,K,M", ",")
       
    'Declare array to hold the source columns' value
    Dim dataCheck As Variant
    Dim dataFirstCol As Variant
    Dim dataSecondCol As Variant
    
    'Array to hold the output value to insert into BOM
    Dim dataOutput As Variant
    ReDim dataOutput(1 To 3, 1 To 200) As Variant
    Dim outputIndex As Long
    
    Dim i As Long
    For i = 0 To UBound(sourceCols) Step 3
        dataCheck = SourceSht.Range(Replace("!9:!100", "!", sourceCols(i))).Value
        dataFirstCol = SourceSht.Range(Replace("!9:!100", "!", sourceCols(i + 1))).Value
        dataSecondCol = SourceSht.Range(Replace("!9:!100", "!", sourceCols(i + 2))).Value
        
        'Loop through the current "check" column
        Dim j As Long
        For j = 1 To UBound(dataCheck, 1)
            If dataCheck(j, 1) <> vbNullString Then
                'If value is not empty, insert the respective value into the output array
                outputIndex = outputIndex + 1
                
                dataOutput(1, outputIndex) = dataCheck(j, 1)
                dataOutput(2, outputIndex) = dataFirstCol(j, 1)
                dataOutput(3, outputIndex) = dataSecondCol(j, 1)
            End If
        Next j
    Next i
    
    'Resize the output array
    ReDim Preserve dataOutput(1 To 3, 1 To outputIndex) As Variant
                        
    '====== Start to insert value in BOM ======
    Dim TargetSht As Worksheet
    Set TargetSht = ThisWorkbook.Sheets("BOM")
    
    ' What row do I start the paste on
    Const startRow As Long = 9
    
    ' Clear the previous BOM items before creating/refreshing
    TargetSht.Rows(startRow & ":" & TargetSht.Rows.Count).ClearContents
    TargetSht.Cells(startRow, 1).Resize(UBound(dataOutput, 2), UBound(dataOutput, 1)).Value = Application.WorksheetFunction.Transpose(dataOutput)
End Sub

我假设您只打算从源文件中读取两个表中的第 9 - 100 行 sheet，因此输出数组的上限固定为 200 并稍后再次调整大小。

将范围内的特定单元格复制到新的工作表范围内

Copy specific cells from range into new worksheet range

excel

vba

copy

paste