Copy information from range of cells in a series of named sheet to another workbook with the same named sheets
Hi All,
So a bit of vba help please and thanks! I'm looking for a macro that will copy and paste the values in a range of cell from the sheets of one workbook to the sheets of another master workbook. I want a macro that will let me select which second workbook to copy from, and then copy the information from the sheets in the second workbook that are named the same as the sheets in the master workbook.
For example:
workbooks: MasterWorkbook (MWB), DataWorkbook1 (DWB1), DataWorkbook2 (DWB2)
The Master Workbook has sheets named A,B,C,D,E,F,G,H DataWorkbook1 has sheets named A,C,D,F, DataWorkbook2 has sheets named B,E,G,H.
All sheets are formatted the same, the same range of cells needs to be copied for every sheet (should be able to loop this).
I want the macro in the Master Workbook to ask me to select a workbook (ie. DWB1 or DWB2) and then copy the information from a specific range of cells the sheets in the data workbook to the sheets with the same name in the master (ie. A to A, then C to C, then D to D, then F to F for DWB1).
I'm not entirely sure where to start as the data going from and to the specific named sheet is important and I'm not sure how to do that.
Any help would be appreciated!
Try This
Hi dear,
Try this hope it will help you....
Sub testing()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wkb As Workbook, wkb2 As Workbook
Dim ShCount As Integer
Dim Sh As Worksheet
Dim MyRange As Range
Dim Rcount As Long
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Title = "Select a file"
.Show
fname = .SelectedItems(1)
End With
Set wkb = ThisWorkbook
ShCount = wkb.Sheets.Count
Workbooks.Open fname
Set wkb2 = ActiveWorkbook
For i = 1 To ShCount
Rcount = wkb.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row + 1
For Each Sh In wkb2.Sheets
If Sh.Name = wkb.Sheets(i).Name Then
Sh.Range("a2").Resize(Cells(Rows.Count, 1).End(xlUp).Row, Cells(3, Columns.Count).End(xlToLeft).Column) _
.Copy Destination:=wkb.Sheets(i).Range("a" & Rcount)
End If
Next Sh
Next i
wkb.Sheets(1).Activate
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Thanks & regards,
http://mrexcel4u.blogspot.in/