从工作表中复制具有相同前导单元格文本的行

Question

所以我已经为此感到困惑了一段时间。 我有两张纸，其中第1栏的某些值以粗体显示。 我希望过滤第二张工作表（“年份设置”）上的值，并使用同一列1粗体文本复制整个数据行。

要从中复制数据的页面

要将数据复制到的页面

例如，我想从第一个链接获取“ Backhoes”行，并将其复制到第二个链接的“ Backhoes”行。

这里的主要问题是首页上带有加粗文本的行是可变的，并且可能始终没有相同的行号。 添加更多设备后，行号将发生变化。

就像我说的，先谢谢您的帮助，我已经为此工作了几天。

此外，数据必须从一行转为一列，但这只是次要的细节。

Answer 1

看这样的东西。 1.在各行中循环查找粗体单元格。 2.遍历所有列，然后将数据从源工作表复制到目标工作表。

Dim lRow As Long
Dim lCol As Long
Dim lRowFind As Long
Dim sourceSheet As Excel.Worksheet
Dim targetSheet As Excel.Worksheet

Set sourceSheet = ActiveWorkbook.Sheets("Current Year Budget")
Set targetSheet = ActiveWorkbook.Sheets("Mult. Year Set up")

    lRow = 5
    Do While lRow <= sourceSheet.UsedRange.Rows.count

        'You could do it by name
        'If ws.Range("A" & lRow).Value = "Backhoes" Or ws.Range("A" & lRow).Value = "Graders" Then

        'If we are looking for variable rows by them being bold. We can do this.
        If sourceSheet.Range("A" & lRow).Font.Bold = True Then

            'Find the row on the target sheet where we want to write the data.
            lRowFind = 1
            Do While lRowFind <= targetSheet.UsedRange.Rows.count
                If targetSheet.Range("A" & lRowFind).Value = sourceSheet.Range("A" & lRow).Value Then
                    Exit Do
                End If
            lRowFind = lRowFind + 1
            Loop

            'Now we have a row that we want to copy.
            For iCol = 1 To sourceSheet.UsedRange.Columns.count
                targetSheet.Cells(lRowFind + iCol, 2).Value = sourceSheet.Cells(lRow, iCol).Value
            Next iCol
        End If


        lRow = lRow + 1
        sourceSheet.Range("A" & lRow).Activate
    Loop