VBA Coding - For Making Consolidated Data sheet by using MultipleSheets data (MultipleSheets डेटा का उपयोग करके समेकित डाटा बनाने के लिए)
VBA Coding - For Making Consolidated Data sheet by using MultipleSheets data
(MultipleSheets डेटा का उपयोग करके समेकित डाटा बनाने के लिए)
(MultipleSheets डेटा का उपयोग करके समेकित डाटा बनाने के लिए)
Sub For_Mastersheet_Update()
Dim wb As Workbook
Dim rng As Range
Set wb =
Workbooks("Pk_File.xlsm")
wb.Activate
Worksheets("Master").Activate
Worksheets("Master").Cells.ClearContents
Worksheets("XYZ2").Activate
Worksheets("XYZ2").Range("a1").CurrentRegion.Select ' For Select Current Region or All Data
Worksheets("XYZ2").Range("a1").CurrentRegion.Copy ' For Copy Select Data
Worksheets("Master").Activate ' For activate sheet
where you want to copy data
Worksheets("Master").Range("a1").PasteSpecial
Paste:=xlPasteValuesAndNumberFormats '
Paste Copy Data
Selection.Columns.AutoFit ' For Selected
Columns Auto Fit
'For Next Sheet Active,Select,Copy &
Active Master sheet With go to End Down Cell command & down one cell more
and Paste & Autofit
Worksheets("XYZ1").Activate
Worksheets("XYZ1").Range("a2").CurrentRegion.Select ' For Select Current Region or All Data
Worksheets("XYZ1").Range("a2").CurrentRegion.Copy
Worksheets("Master").Activate
With
wb.Worksheets("Master").Range("a1").End(xlDown).Select ' For go to END Down cell
ActiveCell.Offset(1, 0).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats '
Down One Cell and PasteValue with Number Format
Selection.Columns.AutoFit
End With
'For Next Sheet Active,Select,Copy &
Active Master sheet With go to End Down Cell command & down one cell more
and Paste & Autofit
Worksheets("XYZ7").Activate
Worksheets("XYZ7").Range("a2").CurrentRegion.Select ' For Select Current Region or All Data
Worksheets("XYZ7").Range("a2").CurrentRegion.Copy
Worksheets("Master").Activate
With
wb.Worksheets("Master").Range("a1").End(xlDown).Select ' For go to END Down cell
ActiveCell.Offset(1, 0).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats '
Down One Cell and PasteValue with Number Format
Selection.Columns.AutoFit
End With
'For Next Sheet Active,Select,Copy &
Active Master sheet With go to End Down Cell command & down one cell more
and Paste & Autofit
Worksheets("XYZ4").Activate
Worksheets("XYZ4").Range("a2").CurrentRegion.Select ' For Select Current Region or All Data
Worksheets("XYZ4").Range("a2").CurrentRegion.Copy
Worksheets("Master").Activate
With
wb.Worksheets("Master").Range("a1").End(xlDown).Select ' For go to END Down cell
ActiveCell.Offset(1, 0).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats '
Down One Cell and PasteValue with Number Format
Selection.Columns.AutoFit
End With
'For Next Sheet Active,Select,Copy &
Active Master sheet With go to End Down Cell command & down one cell more
and Paste & Autofit
Worksheets("XYZ3").Activate
Worksheets("XYZ3").Range("a2").CurrentRegion.Select ' For Select Current Region or All Data
Worksheets("XYZ3").Range("a2").CurrentRegion.Copy
Worksheets("Master").Activate
With
wb.Worksheets("Master").Range("a1").End(xlDown).Select ' For go to END Down cell
ActiveCell.Offset(1, 0).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats '
Down One Cell and PasteValue with Number Format
Selection.Columns.AutoFit
End With
'For Next Sheet Active,Select,Copy &
Active Master sheet With go to End Down Cell command & down one cell more
and Paste & Autofit
Worksheets("XYZ6").Activate
Worksheets("XYZ6").Range("a2").CurrentRegion.Select ' For Select Current Region or All Data
Worksheets("XYZ6").Range("a2").CurrentRegion.Copy
Worksheets("Master").Activate
With
wb.Worksheets("Master").Range("a1").End(xlDown).Select ' For go to END Down cell
ActiveCell.Offset(1, 0).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats '
Down One Cell and PasteValue with Number Format
Selection.Columns.AutoFit
End With
'For Next Sheet Active,Select,Copy &
Active Master sheet With go to End Down Cell command & down one cell more
and Paste & Autofit
Worksheets("XYZ9").Activate
Worksheets("XYZ9").Range("a2").CurrentRegion.Select ' For Select Current Region or All Data
Worksheets("XYZ9").Range("a2").CurrentRegion.Copy
Worksheets("Master").Activate
With
wb.Worksheets("Master").Range("a1").End(xlDown).Select ' For go to END Down cell
ActiveCell.Offset(1, 0).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats '
Down One Cell and PasteValue with Number Format
Selection.Columns.AutoFit
End With
'For Next Sheet Active,Select,Copy &
Active Master sheet With go to End Down Cell command & down one cell more
and Paste & Autofit
Worksheets("XYZ5").Activate
Worksheets("XYZ5").Range("a2").CurrentRegion.Select ' For Select Current Region or All Data
Worksheets("XYZ5").Range("a2").CurrentRegion.Copy
Worksheets("Master").Activate
With
wb.Worksheets("Master").Range("a1").End(xlDown).Select ' For go to END Down cell
ActiveCell.Offset(1, 0).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats '
Down One Cell and PasteValue with Number Format
Selection.Columns.AutoFit
End With
'For Next Sheet Active,Select,Copy &
Active Master sheet With go to End Down Cell command & down one cell more
and Paste & Autofit
Worksheets("XYZ8").Activate
Worksheets("XYZ8").Range("a2").CurrentRegion.Select ' For Select Current Region or All Data
Worksheets("XYZ8").Range("a2").CurrentRegion.Copy
Worksheets("Master").Activate
With
wb.Worksheets("Master").Range("a1").End(xlDown).Select ' For go to END Down cell
ActiveCell.Offset(1, 0).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats '
Down One Cell and PasteValue with Number Format
Selection.Columns.AutoFit
End With
'For Next Sheet Active,Select,Copy &
Active Master sheet With go to End Down Cell command & down one cell more
and Paste & Autofit
Worksheets("XYZ8").Activate
Worksheets("XYZ8").Range("a2").CurrentRegion.Select ' For Select Current Region or All Data
Worksheets("XYZ8").Range("a2").CurrentRegion.Copy
Worksheets("Master").Activate
With
wb.Worksheets("Master").Range("a1").End(xlDown).Select ' For go to END Down cell
ActiveCell.Offset(1, 0).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats '
Down One Cell and PasteValue with Number Format
Selection.Columns.AutoFit
End With
'For Next Sheet Active,Select,Copy &
Active Master sheet With go to End Down Cell command & down one cell more
and Paste & Autofit
Worksheets("XYZ").Activate
Worksheets("XYZ").Range("a2").CurrentRegion.Select ' For Select Current Region or All Data
Worksheets("XYZ").Range("a2").CurrentRegion.Copy
Worksheets("Master").Activate
With
wb.Worksheets("Master").Range("a1").End(xlDown).Select ' For go to END Down cell
ActiveCell.Offset(1, 0).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats '
Down One Cell and PasteValue with Number Format
Selection.Columns.AutoFit
End With
'For Next Sheet Active,Select,Copy &
Active Master sheet With go to End Down Cell command & down one cell more
and Paste & Autofit
Worksheets("XYZ12").Activate
Worksheets("XYZ12").Range("a2").CurrentRegion.Select ' For Select Current Region or All Data
Worksheets("XYZ12").Range("a2").CurrentRegion.Copy
Worksheets("Master").Activate
With
wb.Worksheets("Master").Range("a1").End(xlDown).Select ' For go to END Down cell
ActiveCell.Offset(1, 0).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats '
Down One Cell and PasteValue with Number Format
Selection.Columns.AutoFit
End With
'For Next Sheet Active,Select,Copy &
Active Master sheet With go to End Down Cell command & down one cell more
and Paste & Autofit
Worksheets("XYZ11").Activate
Worksheets("XYZ11").Range("a2").CurrentRegion.Select ' For Select Current Region or All Data
Worksheets("XYZ11").Range("a2").CurrentRegion.Copy
Worksheets("Master").Activate
With
wb.Worksheets("Master").Range("a1").End(xlDown).Select ' For go to END Down cell
ActiveCell.Offset(1, 0).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats '
Down One Cell and PasteValue with Number Format
Selection.Columns.AutoFit
End With
'For Delete Filter Rows except Heading
With
Worksheets("Master").Range("a2:p500")
.AutoFilter field:=1,
Criteria1:="Date"
.EntireRow.Delete
Worksheets("Master").Range("a1").CurrentRegion.Select ' For Select Current Region or All Data
Selection.Columns.AutoFit ' For Columns
Auto Fit
' Table Creation for current selection
Dim tbl As ListObject
Set tbl =
ActiveSheet.ListObjects.Add(xlSrcRange, Selection, xlYes)
tbl.Name = "Master"
End With
End Sub
Comments
Post a Comment
Your advice or suggestions will be much appreciated and welcomed....