循环直到黑色单元格

问题描述

我快到了！但是无法弄清楚循环我的代码的一部分。见底部的“循环部分”

Sub copyPaste()
Dim sh1 As Worksheet,sh2 As Worksheet,sh3 As Worksheet,lastrow As Long,x As Integer,ws As Worksheet


Set ws = ThisWorkbook.Sheets.Add(after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws.Name = "Brand By vendor "

    Sheets("Brand By vendor ").Range("A1") = "STORE"
    Sheets("Brand By vendor ").Range("B1") = "BRAND CODE"
    Sheets("Brand By vendor ").Range("C1") = "BRAND NAME"
    
Set sh3 = Sheets("Brand By vendor ")
Set sh2 = Sheets("Sheet2")
Set sh1 = Sheets("Sheet1")

Sheets("Sheet1").Select
    Range("A2").Select
    Range(Selection,Selection.End(xlToRight)).Select
    Range(Selection,Selection.End(xlDown)).Select
    Selection.copy
    sh3.Range("B2").PasteSpecial Paste:=xlPasteValues,operation:=xlNone,skipblanks _
    :=False,Transpose:=False
sh2.Range("A2").copy
    sh3.Range("A2").PasteSpecial Paste:=xlPasteValues,Transpose:=False
    sh3.Range("A2:A" & Cells(Rows.Count,2).End(xlUp).Row).FillDown
sh2.Activate
Range("A2").Select

'loop portion

Sheets("Sheet1").Select
    Range("A2").Select
    Range(Selection,Selection.End(xlDown)).Select
    Selection.copy
    sh3.Cells(Rows.Count,1).End(xlUp).Offset(1,1).PasteSpecial xlPasteValues
sh2.Activate
    ActiveCell.Offset(1,0).copy
    sh3.Activate
    sh3.Range("A1").End(xlDown).Offset(1,0).PasteSpecial xlPasteValues
    lastrow = Range("B" & Rows.Count).End(xlUp).Row
    ActiveCell.AutoFill Destination:=Range(ActiveCell.Address & ":A" & lastrow)
       
       
End Sub

我希望循环部分一直执行，直到 A 列的 sh2 中有一个空白单元格。谢谢大家的帮助！

解决方法

帖子标题是否应该说“循环直到空白单元格”？描述为空白，标题为黑色。如果为空白，则设置您希望循环遍历 Sheet2.Range("A:A") 的范围。定义你的条件，在你的情况下你可以使用 IsEMpty() 然后做你的事情：

说明：

Dim loopRange As Range
Dim c As Range

Set loopRange = Sheet2.Range("A:A")

For Each c In loopRange 

    If IsEmpty(c) = False Then

      '[Your code block to do stuff within the loop goes here]

    End If
Next c

建议缩短范围，不要遍历 A 列中的所有单元格。

使用您的代码：

Dim sh2LoopRange As Range
Dim c As Range
Dim Sh2LastRow as long

'Find the last row in sheet 2 colum A with content
sh2Lastrow = sh2.Range("A" & sh2.Rows.Count).End(xlUp).Row

'Define the range to run the loop through
Set sh2LoopRange = sh2.Range("A1:A" & sh2Lastrow)

'Iterate through the range
For Each c In sh2LoopRange

'If c is not empty it will do stuff
    If IsEmpty(c) = False Then

       '[Your code block to do stuff within the loop goes here]

    End If
Next c

do-loops loops vba