Loop the code

[adamsm]

Hi,

How could I make the following code to loop through the selected rows.

Any help would be appreciated.

Sub CopyMe()
Dim myrow As Long
Dim wsh As Worksheet
Dim rng As Range
Dim r As Long
myrow = ActiveWindow.RangeSelection.Row
Set wsh = Worksheets("MySheet")
Set rng = wsh.Range("B:B").Find(What:=Range("O6").Value, LookIn:=xlValues, LookAt:=xlWhole)
If rng Is Nothing Then
r = wsh.Range("B" & wsh.Rows.Count).End(xlUp).Row + 1
Else
rng.Offset(1, 0).EntireRow.Insert
r = rng.Row + 1
End If
ActiveSheet.Range("F" & myrow & ":I" & myrow).Copy Destination:=Worksheets("MySheet").Range("C" & r)
ActiveSheet.Range("O6").Copy Destination:=Worksheets("MySheet").Range("B" & r)
Application.CutCopyMode = False
End Sub

[Bob Phillips]

Loop through which selected rows, and do what?

[adamsm]

Thanks for the reply xld.

In the attached workbook; when the user clicks the button by selecting a row between row 18 and 37 the row gets copied to "MySheet", with the cell content in cell O6.

For an example: when the Invoice number is 0001 and the user selects a row (between row 18 & 37), it gets copied below the row 4 in "MySheet".

When the user selects a row by changing the invoice number to 0002 and clicks the button; the row gets copied to the row below where 0001 has been copied to "MySheet".

Again if the user writes invoice number as 0001 ii cell O6 and press the button the copied row does not get copied to the row where 0001 initially exists.

Instead it gets copied to the row below 0002.

How may this be solved. Meaning to loop through the column B and insert the copied row below the corresponding invoice number.

[Simon Lloyd]

Do you mean you want your list in ascending order?, if so just add this line befor end sub in your codeSheets("MySheet").Range("B5:F" & Sheets("MySheet").Range("B" & Rows.Count).End(xlUp).Row).Sort Key1:=Range("B5"), Order1:=xlAscending

[adamsm]

Thanks for the reply Simon. But I'm getting a debug message in doing what you've said. How could I overcome this?

Any help would be kindly appreciated.

[Simon Lloyd]

It should work?, try this and if you get an error message let me know but post the workbook with the line incorporated so i can see what you have done and help further:
Sheets("MySheet").Range("B5:F" & Sheets("MySheet").Range("B" & Rows.Count).End(xlUp).Row).Sort Key1:= Sheets("MySheet").Range("B5"), Order1:=xlAscending

[adamsm]

Thanks for the help Simon. With your second line of help the code works.

If I may ask further help; how shall I modify the code so that it copies columns containing only data from column F to column O (Ignoring the hidden & empty columns). The intension is to paste the copied columns starting from column B to column H into “MySheet” without any empty columns.

[Bob Phillips]

Copy F to O wholesale, then examine the columns in the target sheet (from right o left), and delete empty columns.

[adamsm]

Thanks for the reply xld. But In doing so modifies the headers in MySheet. meaning the columns from the active sheet does not get copied to the appropriate column headers in "MySheet".

Any help on this would be kindly appreciated.

[Simon Lloyd]

xld means copy the usedrange of those columns and paste below your headers, then delete the columns say from Dim Rng as Range
Set Rng = Range("C2:C" & Range("C" & Rows.Count).End(xlUp).row)
If Application.WorksheetFunction.CountA(Rng)=0 Then
Rng.Delete
End Ifapologies if that doesn't work but i just wrote it live and i've been up for 18 hours now, about to go to bed, however, it's just an example and will need further automating to loop through each of your columns applying the test.

[adamsm]

Thanks for the help Simon. But it does not seem to work. I would be happy if I could get a response for this.

Thanks in advance.

[adamsm]

I'm sorry I cant understand what the code does. My Intention is to embbed a line to the existing code in the attached workbook so that it would copy and paste data rows from the active sheet to "MySheet" by ignoring the blank columns.

For example the code would copy the data from columns F,H,K,M,N & O and paste them to "MySheet"s columns C,D,E,F,G & H.

The value in cell O6 gets copied to the column B.

The present code in the attached workbook does copy the empty columns from the active sheet and pastes them in "MySheet" which I'm trying to avoid.

I hope I've made my question clear.

Any help on this would be kindly appreciated.

[Simon Lloyd]

Sorry i posted nonsense before (still tired!) use this:
Sub del_empty()
Dim Rng As Range, i As Long, MyLastRow As Long
MyLastRow = Cells.Find(what:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For i = 8 To 3 Step -1
Set Rng = Range(Cells(2, i), Cells(MyLastRow, i))
If Application.WorksheetFunction.CountA(Rng) = 0 Then
Rng.Delete Shift:=xlToLeft
End If
Next i
End Sub

[Simon Lloyd]

I have looked at your example and did spend a little time trying to create something for you but have just decided not to!, your sheets layout needs totally redisigning, rather than span text across columns for asthetics why not expand the column just like the destination sheet, you will find the whole process a lot easier.

[adamsm]

Thanks for the reply and the attempt. I've tried to implement what you've suggested. But If I tried doing so, I've got to change more than four modules of codes and related sheets as my original workbook is designed by linking to them.

I hope if you could help me on this a bit further.

Any help on this would be kindly appreciated.

Thanks in advance.

[Simon Lloyd]

4 sections of code to change is a small price to pay (and you can use find and replace for the whole project) for something thats going to be a lot more manageable, but i don't see, from your example, what the issue is, just get rid of your blank columns (you can keep the one for code as we can deal with that a different way), other than that im sorry i cant help further!

[adamsm]

Thanks for the reply and your initial help; Simon.