Macro to continue if there is no data to select in a workbook

[LouLee]

Hi, I have a macro that pulls in data from many workbooks. If there is no data in one of the workbooks the macro will not continue. Is there a loop or some other coding I need. The code for one of the worksheets is: (I am new to excel and know there must be parts that can be deleted in the below Workbooks.Open Filename:= _
"J:\SPORTSFORCE\SPORTSFORCE BUSINESS PLANS\Reporting spreadsheet\Cricket.xlsx"
Sheets("Numbers Report ").Select
ActiveSheet.Outline.ShowLevels RowLevels:=2
Range("A6").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Rows.Ungroup
Columns("B:B").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
Range("A1:DJ1").Select
ActiveCell.Offset(1, 0).Range("A1:DJ1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
ThisWorkbook.Activate
Sheets("Numbers Report ").Select
Range("A18").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Range("A18").Select

 

[Michael M]

I might be reading this wrong, and I don't have Excel at the moment, so it's UNTESTED, but try

Dim lr As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
Workbooks.Open Filename:="J:\SPORTSFORCE\SPORTSFORCE BUSINESS PLANS\Reporting spreadsheet\Cricket.xlsx"
Sheets("Numbers Report ").Outline.ShowLevels RowLevels:=2
ActiveSheet.UsedRange.Rows.Ungroup
Columns("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error Resume Next
Range("A1:DJ1").Copy Destination:=Range("A" & lr + 1)
lr = Cells(Rows.Count, "A").End(xlUp).Row

 

[LouLee]

I might be reading this wrong, and I don't have Excel at the moment, so it's UNTESTED, but try

Dim lr As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
Workbooks.Open Filename:="J:\SPORTSFORCE\SPORTSFORCE BUSINESS PLANS\Reporting spreadsheet\Cricket.xlsx"
Sheets("Numbers Report ").Outline.ShowLevels RowLevels:=2
ActiveSheet.UsedRange.Rows.Ungroup
Columns("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error Resume Next
Range("A1:DJ1").Copy Destination:=Range("A" & lr + 1)
lr = Cells(Rows.Count, "A").End(xlUp).Row

Thank you Michael, I will try this when I get to work, after it runs through this Cricket workbook it pastes the data in the Main book, then it goes to the next sport.xlsx workbook and does the same as above. Will it need that same 'On Error Resume Next' if there is nothing to paste into the Main Book? Thanks again for the time you spent helping me I will let you know how I get on.

 

[LouLee]

Great outcome thanks.

Thank you Michael, I will try this when I get to work, after it runs through this Cricket workbook it pastes the data in the Main book, then it goes to the next sport.xlsx workbook and does the same as above. Will it need that same 'On Error Resume Next' if there is nothing to paste into the Main Book? Thanks again for the time you spent helping me I will let you know how I get on.