Hi This is in continuation of the previous thread of mine with title "Macro to copy tables from specific worksheets into a single worksheet."
How do I implement this code in a workbook and get the output file in another work book?
I.e.,
My Macro is in Workbook1 assigned to a button. The Data is in Workbook2 and I want the output in workbook3.
The code is given below for your reference.
Sub ConsolidateSheets()
Dim ms As Worksheet, ws As Worksheet, LR As Long, i As Long, N&
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
On Error Resume Next
If Not Evaluate("ISREF('Consolidate'!A1)") Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Consolidate"
Else
Sheets("Consolidate").Range("A2:I" & Rows.Count).ClearContents
End If
Set ms = Sheets("Consolidate")
For Each ws In ActiveWorkbook.Sheets
With ws
If .Name <> "Consolidate" And .Name <> "Overall Implementation Guide" And .Name <> "RSG Implementation Guide" _
And .Name <> "eCRFs" And .Name <> "Folders" And .Name <> "eCRF Roadmap" And .Name <> "Data Dictionary" _
And .Name <> "Edit Checks" And .Name <> "Derivations & Unit Dictionaries" And .Name <> "Help Text" _
And .Name <> "Scenarios of Intended Use" And .Name <> "Change Details" And .Name <> "History of Revisions" Then
N = .Cells.Find("Additional notes/questions/details:", , , , xlByRows, xlPrevious).Row
If N > 0 Then
.Range("A7:E" & N - 1).Copy
ms.Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
.Range("G7:I" & N - 1).Copy
ms.Range("G" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
ms.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(N - 7) = ws.Name
End If
End If
End With
Next
Sheets("AE").Select
ActiveWindow.SmallScroll Down:=-24
Range("A6:E6").Select
Selection.Copy
Sheets("Consolidate").Select
ActiveWindow.SmallScroll Down:=-6
Range("B1").Select
ActiveSheet.Paste
Sheets("AE").Select
Range("G6:I6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Consolidate").Select
Range("G1").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Form OID"
Range("B1").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Application.CutCopyMode = 0
Set ms = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Bookmarks