conso macro

Joined
Oct 25, 2012
Messages
1
Reaction score
0
we are make the below mention macro in excel but after run the macro get debug

Dim a As Variant

Sub Getdata()
'
' Consolidate Macro
'
' Keyboard Shortcut: Ctrl+w
Application.DisplayAlerts = False
Set sh = Workbooks("Training Scorecard.xlsm").Worksheets("Main")
Z = Application.GetOpenFilename(FileFilter:= _
"Excel files (*.xlsx), *.xlsx", MultiSelect:=True)
If Not IsArray(Z) Then
MsgBox "Nothing selected"
Exit Sub
End If
MsgBox (UBound(Z) & " Files Selected")

For x = 1 To UBound(Z)
'Open the workbook(s) that were selected.
Set bk = Workbooks.Open(Z(x))
'Check if sheet Date exists
'On Error GoTo 'Errfilenotfound:
Sheets("2. Circle Compilation Sheet").Select
a = Range("b1").Value
Range("b5:b12").Select
Selection.Copy

Windows("Training Scorecard.xlsm").Activate
Sheets("Circle Performance Scores").Select

Cells.Find(What:=a, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate


Range(ActiveCell.Address).Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
bk.Activate
Application.CutCopyMode = False


Sheets("2. Circle Compilation Sheet").Select
a = Range("b1").Value
Range("c5:c12").Select
Selection.Copy

Windows("Training Scorecard.xlsm").Activate
Sheets("Head Count").Select

Cells.Find(What:=a, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate

Range(ActiveCell.Address).Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
bk.Activate
Application.CutCopyMode = False


Sheets("2. Circle Compilation Sheet").Select
a = Range("b1").Value
Range("f5:f12").Select
Selection.Copy

Windows("Training Scorecard.xlsm").Activate
Sheets("Trainer efficiancy").Select

Cells.Find(What:=a, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate

Range(ActiveCell.Address).Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
bk.Activate
Application.CutCopyMode = False


Sheets("2. Circle Compilation Sheet").Select
a = Range("b1").Value
Range("d12:e12").Select
Selection.Copy

Windows("Training Scorecard.xlsm").Activate
Sheets("Trainer efficiancy").Select

Cells.Find(What:=a, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate

Range(ActiveCell.Address).Offset(0, 10).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
bk.Activate
Application.CutCopyMode = False



Sheets("2. Circle Compilation Sheet").Select
a = Range("b1").Value
Range("g12:h12").Select
Selection.Copy

Windows("Training Scorecard.xlsm").Activate
Sheets("Trainer efficiancy").Select

Cells.Find(What:=a, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate

Range(ActiveCell.Address).Offset(0, 12).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
bk.Activate
Application.CutCopyMode = False



Sheets("4. Action Plan Tracker").Select
b = Range("c7").Value
Range("c10:i44").Select
Selection.Copy

Windows("Training Scorecard.xlsm").Activate
Sheets("Action Plan Tracker").Select


Cells.Find(What:=b, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate



Range(ActiveCell.Address).Offset(0, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
bk.Activate
Application.CutCopyMode = False

bk.Close
Next x

Sheets("Main").Select
Range("A1").Select

End Sub
 
Back
Top