VBA在列标题中查找空白单元格

我希望你能帮上忙。 我有一段代码，它的工作有点。 我只需要它做更多。

它目前沿着从A1到H1的第一排。 如果find空白单元格，则将单元格值复制到空白单元格的左侧，然后将该值粘贴到空白单元格中，然后一起移动。

由于范围可以从一天到一天改变到H1是不够的。 我现在需要代码来查看第一行，直到find最后一个包含数据的单元，然后查找空白并开始复制和粘贴过程。

我还需要代码然后添加一个2到粘贴的单元格，以便我可以执行一个透视和区分复制的单元格和粘贴。

为了更好的理解，我在下面提供了一张图片。 最终结果应该是单元格B2包含文本24 – 公司：Hier 2和E2包含文本07 – 产品：Family Hier 2

我的代码是低于和往常一样，所有的帮助非常感谢。

图1

我的代码

Public Sub BorderForNonEmpty() Dim myRange As Range Set myRange = Sheet1.Range("A1:H1") For Each MyCell In myRange If MyCell.Text = "" Then MyCell.Offset(0, -1).Select ActiveCell.Copy ActiveCell.Offset(0, 1).PasteSpecial (xlPasteAll) End If Next End Sub 

Answer 1

试试下面的代码 – 注释表明每个重要的行正在做什么：

 Option Explicit Sub FillInHeaders() Dim ws As Worksheet Dim lngRowWithHeaders As Long Dim rngHeader As Range Dim rngCell As Range ' get a reference to your worksheet Set ws = ThisWorkbook.Worksheets("SHeet1") ' set the row that the headers are on lngRowWithHeaders = 2 ' get the range from A1 to ??1 where ?? is last column Set rngHeader = ws.Cells(lngRowWithHeaders, 1) _ .Resize(1, ws.Cells(lngRowWithHeaders, ws.Columns.Count) _ .End(xlToLeft).Column) ' iterate the range and look for blanks For Each rngCell In rngHeader ' if blank then ... If IsEmpty(rngCell.Value) Then ' get cell value from left and a 2 rngCell.Value = rngCell.Offset(0, -1).Value & "2" End If Next rngCell End Sub