Card Maker
08-27-2007, 07:51 AM
Hello all
I'm having another blond moment - again!!
I'm trying to loop through some sheets and copy selected data to another sheet, but my code is falling over - can anyone tell me what I've done wrong?
Sub CheckRecords()
Dim sht As Worksheet
Dim myWbk As Workbook
Dim c As Range
Dim Trainee
Application.ScreenUpdating = False
Trainee = Application.InputBox("Input the delegate's name." & vbCr & "NOTE: name is case sensitive.", "Delegate Record Finder")
If Trainee = False Then
MsgBox "Action cancelled.", vbInformation + vbOKOnly, "Record Finder Error"
Exit Sub
End If
If Trainee = "" Then
MsgBox "No value entered.", vbInformation + vbOKOnly, "Record Finder Error"
Exit Sub
End If
For Each sht In ThisWorkbook.Worksheets
If sht.Name <> "Completed" Then
For Each c In sht.Range("C8", Range("C65536").End(xlUp))
If c.Value = Trainee Then
If c.Offset(0, 1).Value <> " " Then
Range(c.Offset(0, -1), c.Offset(0, 1)).Copy Destination:=ThisWorkbook.Sheets("Completed").Range("A65536").End(xlUp).Offset(1, 0)
End If
End If
Next c
End If
Next sht
ThisWorkbook.Sheets("Completed").Columns("A:C").AutoFit
Application.ScreenUpdating = True
End Sub It falls over when it gets to the bold line. Sorry - meant to say - the ranges are the same on each sheet!
Hope some kind person can put me right!!
Ann
I'm having another blond moment - again!!
I'm trying to loop through some sheets and copy selected data to another sheet, but my code is falling over - can anyone tell me what I've done wrong?
Sub CheckRecords()
Dim sht As Worksheet
Dim myWbk As Workbook
Dim c As Range
Dim Trainee
Application.ScreenUpdating = False
Trainee = Application.InputBox("Input the delegate's name." & vbCr & "NOTE: name is case sensitive.", "Delegate Record Finder")
If Trainee = False Then
MsgBox "Action cancelled.", vbInformation + vbOKOnly, "Record Finder Error"
Exit Sub
End If
If Trainee = "" Then
MsgBox "No value entered.", vbInformation + vbOKOnly, "Record Finder Error"
Exit Sub
End If
For Each sht In ThisWorkbook.Worksheets
If sht.Name <> "Completed" Then
For Each c In sht.Range("C8", Range("C65536").End(xlUp))
If c.Value = Trainee Then
If c.Offset(0, 1).Value <> " " Then
Range(c.Offset(0, -1), c.Offset(0, 1)).Copy Destination:=ThisWorkbook.Sheets("Completed").Range("A65536").End(xlUp).Offset(1, 0)
End If
End If
Next c
End If
Next sht
ThisWorkbook.Sheets("Completed").Columns("A:C").AutoFit
Application.ScreenUpdating = True
End Sub It falls over when it gets to the bold line. Sorry - meant to say - the ranges are the same on each sheet!
Hope some kind person can put me right!!
Ann