Sub checkForValue()
Dim currentSheet As Worksheet, ws As Worksheet
Dim currentSelection As Range, target As Range, subTarget As Range
Dim screenUpdate As Boolean
screenUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
'the program records the current worksheet and current selection
'so at the end of the program you can have the program go back to
'where you were originally
Set currentSheet = Application.ActiveSheet
Set currentSelection = Application.Selection
Set target = Range("B4:B253")
For Each subTarget In target
If subTarget.Value <> "" Then
Range(subTarget, subTarget.End(xlToRight)).Copy
Worksheets("Storage").Select
Range("A1").Activate
'check to see if the cell A2 is blank, if it is not blank then
'essentially press Crtl + down arrow to dynamically find the last cell
If ActiveCell.Offset(1, 0).Value <> "" Then
Selection.End(xlDown).Select
End If
'offset the address of the active cell by 1 row and then paste,
'if you did not do this you would overwrite the old values
ActiveCell.Offset(1, 0).Activate
'paste everything
ActiveCell.PasteSpecial xlPasteAll
Worksheets("ResultsLog").Select
End If
Next
Application.CutCopyMode = False
currentSheet.Select
currentSelection.Select
Application.ScreenUpdating = ScreenUpdating
Set currentSheet = Nothing
Set ws = Nothing
Set currentSelection = Nothing
Set target = Nothing
Set subTarget = Nothing
End Sub
|