我正在嘗試從一個工作簿復制行並根據特定列中的文本粘貼到另一個工作簿

Question

我對 VBA 很陌生，似乎無法讓它工作。 我想獲取模板中的所有數據，並根據“G”列中的文本復制並粘貼到另一個工作簿中。 我希望將其粘貼在目標文件中任何現有數據的下方。 運行時，所有 4 個工作簿都將打開。

我目前在這部分代碼中遇到編譯錯誤。 “未找到方法或數據成員”

-- For Each c In Source.Range("G1:G" & Source**.Cells**(Rows.Count, 1).End(xlUp).Row)--

'copy and paste data from template into existing workbooks

Dim c As Range
Dim Source As Workbooks
Dim Target As Workbooks
Dim Target1 As Workbooks
Dim Target2 As Workbooks


'define source and targets for workbooks and worksheets
Set Source = Workbooks("CostIncreaseTemplate.xlsm").Worksheets("Sheet1")
Set Target = Workbooks("Fresh.xlsx").Worksheets("Fresh")
Set Target1 = Workbooks("CannedGoods.xlsx").Worksheets("CannedGoods")
Set Target2 = Workbooks("Baking.xlsx").Worksheets("Baking")

'Specify where to search and copy the entire row if criteria is met and paste in target file in the next blank cell

For Each c In Source.Range("G1:G" & Source.Cells(Rows.Count, 1).End(xlUp).Row)
   If c = "Fresh" Then
      c.EntireRow.Copy
      Target.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   ElseIf c = "CannedGoods" Then
      c.EntireRow.Copy
      Target1.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   ElseIf c = "Baking" Then
      c.EntireRow.Copy
      Target2.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   End If
Next c

End Sub

任何幫助，將不勝感激。

Answer 1

導出行

• 發生錯誤是因為您已將Source聲明為沒有.Range且沒​​有.Cells方法或數據成員的工作簿集合對象。

Sub ExportRows()

    Dim Source As Worksheet
    Set Source = Workbooks("CostIncreaseTemplate.xlsm").Worksheets("Sheet1")
    ' If the code is in 'CostIncreaseTemplate.xlsm', replace the previous line
    ' with:
    'Set Source = ThisWorkbook.Worksheets("Sheet1")
    Dim srg As Range
    Set srg = Source.Range("G2", Source.Cells(Source.Rows.Count, "G").End(xlUp))
    Dim scCount As Long: scCount = Source.Columns.Count
    
    Dim Target As Worksheet
    Dim Target1 As Worksheet
    Dim Target2 As Worksheet
    
    Set Target = Workbooks("Fresh.xlsx").Worksheets("Fresh")
    Set Target1 = Workbooks("CannedGoods.xlsx").Worksheets("CannedGoods")
    Set Target2 = Workbooks("Baking.xlsx").Worksheets("Baking")
    
    Dim sCell As Range
    Dim tCell As Range
    
    For Each sCell In srg.Cells
        If StrComp(CStr(sCell.Value), "Fresh", vbTextCompare) = 0 Then
            Set tCell = Target.Cells(Target.Rows.Count, "A").End(xlUp)
        ElseIf StrComp(CStr(sCell.Value), "CannedGoods", vbTextCompare) = 0 Then
            Set tCell = Target1.Cells(Target1.Rows.Count, "A").End(xlUp)
        ElseIf StrComp(CStr(sCell.Value), "Baking", vbTextCompare) = 0 Then
            Set tCell = Target2.Cells(Target2.Rows.Count, "A").End(xlUp)
        End If
        If Not tCell Is Nothing Then
            ' When copying values only, copying by assignment is most efficient:
            tCell.Offset(1).Resize(, scCount).Value = sCell.EntireRow.Value
            Set tCell = Nothing
        End If
    Next sCell
    
    MsgBox "Rows exported.", vbInformation
    
End Sub