我正在尝试从一个工作簿复制行并根据特定列中的文本粘贴到另一个工作簿

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