从列的单元格复制到特定的单元格

我正在创buildExcel的代码以将上一列中单元格的内容复制到下一个单元格。 我想要复制的内容的单元格是绿色的。 但是我需要search整个工作簿和所有工作表中的所有内容,因为每个绿色单元格可以位于不同的列中。 我的代码是:

Dim wb As Workbook Dim sht As Worksheet frow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row fcol = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Column Cells.UnMerge Set wb = ActiveWorkbook For Each sht In wb.Sheets For ncol = 1 To fcol For nrow = 1 To frow If Cells(nrow, ncol).Interior.Color = RGB(0, 128, 0) Then Cells(nrow, ncol - 1).Copy Cells(nrow, ncol).Select ActiveSheet.Paste Cells(nrow, ncol).Interior.Color = RGB(0, 128, 0) End If Next Next 

但问题是,在一些表格中,绿色单元格的列是空的,代码只获取所有包含内容的列(因此fcol是totalColumnstoProcess-1),因此它不会将内容复制到我希望的单元格。

总结:我想要转到工作簿中的所有工作表,检查哪里有绿色单元格,并将该内容复制到下一列,同一行。

有没有其他的方式来处理表中的所有内容? 任何想法,为什么我的代码不起作用?

我认为你的代码可能有一些问题。

  1. 您需要逐个工作表定义工作表的search区域,因此需要将其放在循环中。
  2. UsedRange通常是要避免的,因为它可以select格式和内容,但在你的情况下,它会工作得很好。 您的活动区域定义只会提取内容。

下面的代码应该有所帮助,但是如果有两个相邻的绿色单元,则需要更多的考虑。

  Dim ws As Worksheet Dim rng As Range Dim cell As Range Const GREEN As Long = 32768 'RGB(0, 128, 0) For Each ws In ThisWorkbook.Worksheets ' Define the range we want to interrogate Set rng = ws.UsedRange ' Check we have some cells to work with. If rng.Cells.Count > 1 Or rng.Cells(1, 1).Interior.Color = GREEN Then For Each cell In rng 'Find a green cell, making sure it isn't in Column "A" If cell.Column > 1 And cell.Interior.Color = GREEN Then cell.Value = cell.Offset(, -1).Value2 'if you want to delete the old cell's value then uncomment the next line cell.Offset(, -1).Value = vbNullString End If Next End If Next 

除非我错过了一些东西,不应该这样做吗?

 dim r as range dim ws as worksheet for each ws in worksheets for each r in ws.usedrange if r.Interior.Color = RGB(0, 128, 0) Then r = r.offset(0,-1) end if next r next ws