Question

所以我被这一段时间困扰了一段时间。我有两张表，其中一些值在第1列加粗。我希望过滤第二张表（多年设置）上的值，并使用相同的列1粗体文本复制整行数据。

Page from Which data is to be coppied

Page Which Data is to be coppied to

例如，我想采取＆＃34;反铲＆＃34;从第一个链接开始并将其复制到＆＃34; Backhoes＆＃34;在第二个链接上排。

这里的主要问题是第一页上带有粗体文本的行是可变的，并且可能不会总是具有相同的行号。添加更多设备时，行号将发生变化。

正如我所说的那样，提前感谢您的帮助，我已经为此做了几天了。

此外，数据必须从一行转换为一列，但这只是一个小细节。

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

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

1 个答案: