If Then Else looping problem
 

The following code will test two conditions in a worksheet, the
copy/paste some values on that worksheet to a different workbook an
worksheet, based on the tested conditions. This is if/then/else i
nested within a For Each worksheet loop.

It works okay, except that the way I have it incrementing rows isn'
working right. It seems that it increments several times pe
worksheet, maybe something to do with the if/then/else structure..
Anyway, I'd like the pasted data to be in consecutive rows, but instea
it is spaced by varying empty rows. Any ideas what's causing this?

Thanks... here's the code...

Sub concatenate2()
'On Error GoTo LASTSHEET
Application.ScreenUpdating = False
Dim Wkbk As Workbook
Dim wksht As Worksheet
Dim destWks As Worksheet
Dim destCell As Range
Dim drow As Integer

Set Wkbk = Workbooks("ajx.xls")
drow = 3

For Each wksht In Wkbk.Worksheets

If wksht.Range("K5") = 500 And wksht.Range("G7") = "UP" Then
Set destWks = Workbooks("combined2.xls").Worksheets("sheet1")
ElseIf wksht.Range("K5") = 500 And wksht.Range("G7") = "DOWN" Then
Set destWks = Workbooks("combined2.xls").Worksheets("sheet2")
ElseIf wksht.Range("K5") = 1000 And wksht.Range("G7") = "UP" Then
Set destWks = Workbooks("combined2.xls").Worksheets("sheet3")
ElseIf wksht.Range("K5") = 1000 And wksht.Range("G7") = "DOWN
Then
Set destWks = Workbooks("combined2.xls").Worksheets("sheet4")
ElseIf wksht.Range("K5") = 2000 And wksht.Range("G7") = "UP" Then
Set destWks = Workbooks("combined2.xls").Worksheets("sheet5")
ElseIf wksht.Range("K5") = 2000 And wksht.Range("G7") = "DOWN
Then
Set destWks = Workbooks("combined2.xls").Worksheets("sheet6")
ElseIf wksht.Range("K5") = 4000 And wksht.Range("G7") = "UP" Then
Set destWks = Workbooks("combined2.xls").Worksheets("sheet7")
Else
Set destWks = Workbooks("combined2.xls").Worksheets("sheet8")
End If

With destWks
Set destCell = .Cells(drow, 1)
End With

wksht.Range("J12:O12").Copy
destCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
SkipBlanks _
:=False, Transpose:=False

drow = drow + 1
Next
LASTSHEET:
End Su

--
Kieran102
-----------------------------------------------------------------------
Kieran1028's Profile: http://www.excelforum.com/member.php...fo&userid=1567
View this thread: http://www.excelforum.com/showthread.php?threadid=27746

If Then Else looping problem
 

Kieran,

You need to have separate drow incrementors for each sheet you're pasting
to.

Your code would work as you mean it to if you were pasting to the same sheet
every time, i.e., if the If condition was the same every time. On the other
hand, if you met each If condition only once then you wouldn't want to
increment at all, because you'd want to paste to row 3 of each sheet.

You could also find the last used cell in column A by something like:

destWks.Range("A" & Rows.Count).End(xlup)

hth,

Doug Glancy

"Kieran1028" wrote in message
...

The following code will test two conditions in a worksheet, then
copy/paste some values on that worksheet to a different workbook and
worksheet, based on the tested conditions. This is if/then/else is
nested within a For Each worksheet loop.

It works okay, except that the way I have it incrementing rows isn't
working right. It seems that it increments several times per
worksheet, maybe something to do with the if/then/else structure...
Anyway, I'd like the pasted data to be in consecutive rows, but instead
it is spaced by varying empty rows. Any ideas what's causing this?

Thanks... here's the code...

Sub concatenate2()
'On Error GoTo LASTSHEET
Application.ScreenUpdating = False
Dim Wkbk As Workbook
Dim wksht As Worksheet
Dim destWks As Worksheet
Dim destCell As Range
Dim drow As Integer

Set Wkbk = Workbooks("ajx.xls")
drow = 3

For Each wksht In Wkbk.Worksheets

If wksht.Range("K5") = 500 And wksht.Range("G7") = "UP" Then
Set destWks = Workbooks("combined2.xls").Worksheets("sheet1")
ElseIf wksht.Range("K5") = 500 And wksht.Range("G7") = "DOWN" Then
Set destWks = Workbooks("combined2.xls").Worksheets("sheet2")
ElseIf wksht.Range("K5") = 1000 And wksht.Range("G7") = "UP" Then
Set destWks = Workbooks("combined2.xls").Worksheets("sheet3")
ElseIf wksht.Range("K5") = 1000 And wksht.Range("G7") = "DOWN"
Then
Set destWks = Workbooks("combined2.xls").Worksheets("sheet4")
ElseIf wksht.Range("K5") = 2000 And wksht.Range("G7") = "UP" Then
Set destWks = Workbooks("combined2.xls").Worksheets("sheet5")
ElseIf wksht.Range("K5") = 2000 And wksht.Range("G7") = "DOWN"
Then
Set destWks = Workbooks("combined2.xls").Worksheets("sheet6")
ElseIf wksht.Range("K5") = 4000 And wksht.Range("G7") = "UP" Then
Set destWks = Workbooks("combined2.xls").Worksheets("sheet7")
Else
Set destWks = Workbooks("combined2.xls").Worksheets("sheet8")
End If

With destWks
Set destCell = .Cells(drow, 1)
End With

wksht.Range("J12:O12").Copy
destCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

drow = drow + 1
Next
LASTSHEET:
End Sub


--
Kieran1028
------------------------------------------------------------------------
Kieran1028's Profile:
http://www.excelforum.com/member.php...o&userid=15678
View this thread: http://www.excelforum.com/showthread...hreadid=277464