Do While loop

**JonathanMoore** · 09-12-2011, 10:35 AM

Hi Gang,

I'm a complete beginner to VBA loops. I've got an idea that I want to try out, but i'm unsure as to how to do it.

OK. I have the following code that selects a number of cells, then performs a paste-special command into a different sheet.

Sub Macro4()

    ThisWorkbook.Sheets("Sheet1").Select
    ActiveSheet.Range("A1:H1").Select
    Selection.Copy
    ThisWorkbook.Sheets("ADMLOD").Select
    ActiveSheet.Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
End Sub

I need a loop that adds 1 to the first selected range (i.e. Range("A1:H1") becomes Range("A2:H2") and so on...) but also adds 8 to the second selected range (i.e. Range("A3") becomes Range("A11") etc etc). It should loop until the first Range ( Sheet1.Range("A1:H1")) reaches a blank cell.

Does anyone have any ideas about what I can do? As I said, i'm completely new to loops, but very willing to learn

Thanks in advance,

- Jon

**Kelshaer** · 09-12-2011, 10:39 AM

you have to tell when the loop will end or it will be an open one that will just keep on going forever

**snb** · 09-12-2011, 10:49 AM

Before that you can reduce your code to:

 
Sub snb()
 with ThisWorkbook
   .Sheets("ADMLOD").Range("A3:H3")=.Sheets("Sheet1").Range("A1:H1").Value
  end with
End Sub

**JonathanMoore** · 09-12-2011, 03:57 PM

Thanks for the replies as ever!

The only problem with reducing my code to what SNB suggests is that I need to keep the paste special stuff so it transposes into a single column rather than the columns A to H. Or would modifying your code to:

Sub snb()
 with ThisWorkbook
   .Sheets("ADMLOD").Range("A3:H3")=.Sheets("Sheet1").Range("A1:A8").Value
  end with
End Sub

work?

I would still need a loop that added 1 to my first range (i.e. A4:H4 and so on) and 8 to the second range (I.e. A9:A16 and so on).

@Kelshaer - is it possible to loop all the way to the bottom of the file and stop when it finds a blank cell? I can't specify how many rows it will have to loop through so I think it would be easier if it went through the entire document (as specified by the ranges quoted) and then stopped looping when it reaches a blank cell at the bottom.

Hope this is a little clearer,

thanks again,

- Jon

**Kelshaer** · 09-12-2011, 05:09 PM

here you go.
Please mark the thread as SOLVED if it is

Sub Macro1()
Dim i, n, r As Integer
Dim objSHT As Worksheet

Set objSHT = ThisWorkbook.Sheets("Sheet1")
r = objSHT.UsedRange.Rows.Count
i = 1
n = 3
Do
    objSHT.Range("A" & i & ":H" & i).Select
    Selection.Copy
    ThisWorkbook.Sheets("ADMLOD").Select
    ActiveSheet.Range("A" & n).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    i = i + 1
    n = n + 8

Loop While i <= r


End Sub

**snb** · 09-12-2011, 05:56 PM

Avoid using Select & activate in VBA

Sub snb()
 with ThisWorkbook
   sn=.Sheets("Sheet1").cells(1).currentregion
   for each cl in sn
     c01=c01 & "|" & cl
   next
   sn=split(mid(c01,2),"|")
   .Sheets("ADMLOD").cells(3,1).resize(ubound(sn)+1)=application.transpose(sn)
 end with
End Sub

**JonathanMoore** · 09-13-2011, 04:43 AM

Thanks guys, that all works brilliantly - thanks for all of your help, I think i'm starting to get my head around these loops.

I'll mark this thread as SOLVED now. thanks again!

- Jon