Copy multiple columns in a loop

**rhudgins** · 07-08-2010, 05:21 PM

On "Sheet 2" there are 24 names in row 45 (more will be added later). Below each name are a maximum of 30 stock symbols. For the first name, I need to copy the symbols and paste them into A6:A35. Data will then populate in S36:AI36. Copy S36:AI36 to "Sheet 1" B3:R3.

Next go back to "Sheet 2" clear the range A6:A35 and repeat the same process for the 2nd, 3rd, 4th name ect.

**rylo** · 07-08-2010, 06:51 PM

Hi

see how this goes.

Sub aaa()
  Dim DataSH As Worksheet, OutSH As Worksheet
  Dim NameRng As Range
  Set DataSH = Sheets("Sheet2")
  Set OutSH = Sheets("Sheet1")
  With DataSH
    Set NameRng = .Range(.Range("S45"), .Range("S45").End(xlToRight))
  End With
  
  For Each ce In NameRng
    outrow = WorksheetFunction.Match(ce.Value, OutSH.Range("A:A"), 0)
    DataSH.Range("A6:A35").Value = ce.Offset(1, 0).Resize(30, 1).Value
    OutSH.Cells(outrow, 2).Resize(1, 17).Value = DataSH.Range("S36:AI36").Value
  Next ce
  
End Sub

rylo