I am running a routine that pulls in one workbook at a time, copies pertinent information and compiles it on one worksheet. The sheet names vary so I call them using sheet number (ie. wb.worksheets(2)) however some workbooks have a 4th or 6th sheet (always the same positions but different names hence calling sheet numbers vs names) is there a way I can place a loop at the end of my code to say "if sheet 4 exists, then change the Wb.worksheets(2) to be wb.worksheets(4) and rerun the script on THAT sheet, then if sheet(6) exists and so on, until those don't exists and then move on. Here is my code, it is NOT the cleanest and needs some consolidation, I know, but that isn't my focus yet.
I have truncated the coped with elipses (...) for inconsequential things that repeat.
Private Sub DoSomething(ByRef wb As Workbook, ByVal CurrentRow As Long)
truncated for readability
....
Dim wb2 As Workbook
....
Dim wsCheck As Worksheet
. . .
Set wb2 = Workbooks("Targets09.30.14V1 - Copy.xlsx")
Set wsCheck = wb.Worksheets(2)
step1:
'******************************Risk A copy/paste (repeats for each sheet)***********************************
'***********************Copy Base Data columns (Clinical Episode, MSDRG and N)
'set the copy range
With wsCheck
Set copyBaseDataFrom = .Range(.Range("A5"), .Range("C5").End(xlDown))
End With
'set where we are copying to
Set copyBaseDataTo = wb2.Worksheets(2).Range("C" & Rows.count).End(xlUp).Offset(1, 0)
'perform the copy/paste without the borders
copyBaseDataFrom.Copy
copyBaseDataTo.PasteSpecial Paste:=xlPasteAllExceptBorders
Application.CutCopyMode = False
'************************** set copy/Paste Range for Risk A
'set the copy range
With wsCheck
Set copyRiskAFrom = .Range(.Range("D5"), .Range("H5").End(xlDown))
End With
'set where we are copying to
Set copyRiskATo = wb2.Worksheets(2).Range("F" & Rows.count).End(xlUp).Offset(1, 0)
'perform the copy/paste without the borders
copyRiskAFrom.Copy
copyRiskATo.PasteSpecial Paste:=xlPasteAllExceptBorders
Application.CutCopyMode = False
'************************************** Risk A Definition
'capture the Risk Definition
With wsCheck
Set riskA = .Range("D3")
End With
'determine the last full cell in Column K and start in the next one down
With wb2.Worksheets(2)
lcellA = .Range("K" & Rows.count).End(xlUp).Offset(1).row
End With
'copy the Risk Definition name to the first empty cell in column K
riskA.Copy Destination:=wb2.Worksheets(2).Range("K" & lcellA)
'autofill the Risk definition from the first cell its in, down the the last row with data in column C
With wb2.Worksheets(2)
lcellA2 = .Range("K" & Rows.count).End(xlUp).row
lrowA = .Range("C" & Rows.count).End(xlUp).row
.Range("K" & lcellA2 & ":K" & lrowA).FillDown
End With
. . .
'test to see if another workbook is open
Dim wsSheet As Worksheet
On Error Resume Next
Set wsSheet = wb.workseets(4)
On Error GoTo 0
If Not wsSheet Is Nothing Then
Set wsCheck = wb.Worksheets(4)
GoTo step1
Else
Exit Sub
End If
End Sub
Bookmarks