loop trough range do something on not empty cell

[stunik94]

hello,

i'm trying to make a list to order items.
i have a default file to order items here.

my current list is a small, for specific persons only, list
if they need an item they fill in Cells F8:F43
if they fill out one or more of the cells the VBA script has to copy a specific cell from the same row but in column S to another file.

i can typ them out 1 by 1 but this will take a lot of time.

Dim db, bl As Workbook
Set db = ActiveWorkbook

Workbooks.Open (ActiveWorkbook.Path & "\" & "xxxxxxxxxxxxxxx")
Set bl = ActiveWorkbook

db.Activate

ActiveWorkbook.Sheets("xxxxxxxxxxxxx").Activate
Range("F8").Select
If ActiveCell.Value = "" Then

Else
Range("S8").Select
Selection.Copy
bl.Activate
Range("C12").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If

db.Activate
ActiveWorkbook.Sheets("xxxxxxxxxxxxxxxxx").Activate
Range("F9").Select
If ActiveCell.Value = "" Then

Else
Range("S9").Select
Selection.Copy
bl.Activate
Range("C12").Select
If ActiveCell.Value = "" Then
Range("C12").PasteSpecial Paste:=xlPasteValues
Else
Range("C13").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
end If
End If

End Sub

is there anyway to make a small loop instead of typing it out cell by cell?

 

[mumps]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your two sheets. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary). Please use actual sheet names and workbook names and extensions in your description.

 

[scottleger4]

If I am understanding your question properly, try something like this...I'm assuming in this example your "specific cell from the same row" (RefCell below) is in column G, but that can be adjusted to your liking. Some of the other stronger coders might have some suggestions to make this more efficient, but this should work for what you want. I'm also throwing this together quickly and blindly, so it might not be perfect...might be some wrinkles/bugs to iron out.

Sub Loop()

Dim LISTsheet As Worksheet
Set LISTsheet = ActiveWorkbook.ActiveSheet

Workbooks.Open Filename:= _
       "C:\Other File.xlsx"

Dim OTHERsheet As Worksheet
Set OTHERsheet = ActiveWorkbook.ActiveSheet

Dim ColumnF As String
Dim ColumnFText As Range
Dim RefCell As String
Dim RefCellText As Range
Dim ColumnS As String
Dim ColumnSText As Range

Set ColumnF = LISTsheet.Range("F8")
Set RefCell = LISTsheet.Range("G8")
Set ColumnS = OTHERsheet.Range("S8")

Do Until ColumnFText.Text= ""
ColumnF = ColumnFText.Text
RefCell = RefCellText
ColumnS = ColumnSText

RefCell.Select
RefCell.Copy
ColumnS.Select
ActiveSheet.Paste

Set ColumnFText= ColumnFText.Offset(1, 0)
Set RefCellText= RefCellText.Offset(1, 0)
Set ColumnSText= ColumnSText.Offset(1, 0)
Loop

End Sub