Pull the important info from the garbadge in an excel sheet,

[tonywatsonhelp]

Hi everyone,

I have two Excel sheets, one is my working doc that will hold the macro and can be called This workbook,
and Another, I won't know this document's name but it will be the only other Excel document open.

I need to pull all my employee's sales and commission details from this other sheet into This workbook so I can calculate their sales etc. but when we download our accountant's system is very old and the only report he can give us also has loads of other data and wording to it which I need to get rid of.
I've looked at these reports and the only consistency I can find is the data I want always has the header "No" before it in column A and when it ends it always has "Sub Total" in column O,
so I was thinking if I could get a macro that could find each instance of "No" and copy that data down to "Subtotal" and paste it into This document sheet "Data" I could clean it up and use it from there, but I don't know how to get it to work multiple times, and I won't know if its once or 50+ times as each report will be for a different number of days.

If you can help that would be great, Heres a breif of what I need:


I need a macro that when run can do the following,

First check that the only Excel documents open are the one the macro is being run from, my personal workbook (If there is one), and one other sheet,

Now here the big problem,

I don't know what that sheet will be called but it will always be an XLS doc

so with other Excel doc goto active sheet and look down column A, each time it finds a cell that contains "No" as the only word in it, look down column O and find the word "subtotal" and copy everything in the rows from "On" to "SubTotal" columns A to Z and paste in this in workbook sheet "Data" column A and last row, now there will possibly be more than one time this happens so I need the macro to get all of them.

please help if you can
Thanks
Tony

 

[I_know_nuffin]

So are you saying

column A row 6 has No and Col O row 6 has subtotal :- so copy the row range (A6:Z6)
or
column A row 6 has No and Col O row 26 has subtotal :- so copy the range A6:Z26

or could it be a mixture of single rows and multiple rows in the sheet?

 

[tonywatsonhelp]

Hi I know Nuffin,
I'm saying Column A find "No", = (Row 6 for example)
Column O after Row 6 find the next "Subtotal" (Row 15 for example)
then copy range A6:Z15,
then look for "No" again, do the same until there are no more "No"s

 

[tonywatsonhelp]

Any ideas with this one?

 

[I_know_nuffin]

try the below

this is run from the workbook your copying into - 'this workbook' in your original question

it asks for the workbook name to use from all open workbooks
then asks for the sheetname to use from the chosen workbook

you need to update the sheetname your copying the data into here

' change sheet name below to the sheet name that your copying into
Set ws = wb.Sheets("Copytosheetname")

Sub copyrows()
Dim lastrow As Long, lastrow1 As Long, x As Long, y As Long
Dim searchstr1 As String, searchstr2 As String
Dim ws As Worksheet, ws1 As Worksheet
Dim wb As Workbook, wb1 As Workbook
Dim datasheet As String


For Each wb In Workbooks
If wb.Name <> ActiveWorkbook.Name Then
'Debug.Print wb.Name
xyz = MsgBox("Use this Workbook :- " & wb.Name, vbYesNo)
If xyz = vbYes Then
Set wb1 = wb
Exit For
End If
End If
Next


For Each ws In wb1.Worksheets
xyz = MsgBox("Use this Worksheet :- " & ws.Name, vbYesNo)
If xyz = vbYes Then
datasheet = ws.Name
Exit For
End If
Next ws


Application.ScreenUpdating = False



Set wb = ActiveWorkbook


' change sheet name below to the sheet name that holds your data
' now selected in the code above
Set ws1 = wb1.Sheets(datasheet)

' change sheet name below to the sheet name that your copying into
Set ws = wb.Sheets("Copytosheetname")

searchstr1 = "No "
searchstr2 = "Subtotal "

ws1.Activate
 
 lastrow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
 
 For x = 2 To lastrow
 
 If Left(Range("A" & x), 3) = searchstr1 Then
 ' found "No "
 
 For y = x To lastrow
 If Left(Range("O" & y), 9) = searchstr2 Then
 ' found "Subtotal "
 
 Range("A" & x & ":Z" & y).Select
 Selection.Copy
 lastrow1 = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
 
 ws.Activate
 Range("A" & lastrow1).Select
 ActiveSheet.Paste
 ws1.Activate
 
 x = y
 Exit For
 End If
 Next y
 End If
 Next x


Application.ScreenUpdating = True

End Sub

 

[tonywatsonhelp]

Thanks I Know Nuffin,
I give it a try,
much appreciated.
Tony