Do Loop Until Black Cell - vba

Question

I am almost there! But having trouble figuring out out to loop a portion of my code. See "loop portion" towards the bottom
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, operation:=xlNone, skipblanks _
:=False, 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(xlToRight)).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
I want the loop portion to execute until the there is a blank cell in sh2 in Column A. Thank you guys for your help!

Answer 1

Should the post title say "Do Loop Until Blank Cell"? The description says Blank and the title Black. If Blank, set the range that you will like to loop through Sheet2.Range("A:A") for instance. Define your conditional, in your case you could use IsEMpty() and then do your stuff:
Illustrative:
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
Is recomendable to shorten the range not to loop through all the cells in column A.
Using your code:
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