Copy diff workbook data in one

Sub Copy_different_file_data_in_one_file()

'VBA Macro Code to Copy Different workbook data in one workbook and compile it

MkDir "D:\Study\Excel and VBA Practice\Macro18Jan"
MkDir "D:\Study\Excel and VBA Practice\Macro18Jan\VBAClass"

Workbooks.Add
ActiveWorkbook.SaveAs "D:\Study\Excel and VBA Practice\Macro18Jan\VBAClass\Jan.xlsx"

Workbooks.Add
ActiveWorkbook.SaveAs "D:\Study\Excel and VBA Practice\Macro18Jan\VBAClass\Feb.xlsx"

Workbooks.Add
ActiveWorkbook.SaveAs "D:\Study\Excel and VBA Practice\Macro18Jan\VBAClass\Mar.xlsx"

Workbooks.Add
ActiveWorkbook.SaveAs "D:\Study\Excel and VBA Practice\Macro18Jan\VBAClass\Working.xlsx"

Workbooks("Jan.xlsx").Sheets("Sheet1").Activate
Range("A1").CurrentRegion.Copy
Workbooks("working.xlsx").Sheets("Sheet1").Activate
Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
ActiveSheet.Name = "Jan"


Workbooks("Feb.xlsx").Sheets("Sheet1").Activate
Range("A1").CurrentRegion.Copy
Workbooks("working.xlsx").Sheets("Sheet2").Activate
Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
ActiveSheet.Name = "Feb"

Workbooks("Mar.xlsx").Sheets("Sheet1").Activate
Range("A1").CurrentRegion.Copy
Workbooks("working.xlsx").Sheets("Sheet3").Activate
Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
ActiveSheet.Name = "Mar"

Workbooks("Jan.xlsx").Activate
ActiveWorkbook.Close True

Workbooks("Feb.xlsx").Activate
ActiveWorkbook.Close True

Workbooks("Mar.xlsx").Activate
ActiveWorkbook.Close True

Workbooks("Working.xlsx").Activate
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Report"


Workbooks("Working.xlsx").Sheets("Jan").Activate
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Copy
Workbooks("working.xlsx").Sheets("Report").Activate
Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False

Workbooks("Working.xlsx").Sheets("Jan").Activate
Range("A1").CurrentRegion.Copy
Sheets("Report").Activate
Range("A2000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
ActiveCell.EntireRow.Delete

Workbooks("Working.xlsx").Sheets("Feb").Activate
Range("A1").CurrentRegion.Copy
Sheets("Report").Activate
Range("A2000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
ActiveCell.EntireRow.Delete

Workbooks("Working.xlsx").Sheets("Mar").Activate
Range("A1").CurrentRegion.Copy
Sheets("Report").Activate
Range("A2000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
ActiveCell.EntireRow.Delete

Application.DisplayAlerts = False
Sheets("Jan").Delete
Sheets("Feb").Delete
Sheets("Mar").Delete

ActiveWorkbook.Close True

End Sub

Comments

Popular posts from this blog

TDS Calculation System

VBA - Additional Controls Dialog Box "MISSING"

Loan EMI Calculator Dashboard