Copying data from one workbook sheet to another workbook sheet without overwrriting

[Amol1988]

The two sheets are...

1. Sheet1.xlsx (regular excel sheet as the extension is .xlsx)
2. Consolidated.xlsm (macro enabled sheet as its extension is .xlsm)

1. Copy both the files on your system under a particular folder.
2. Now make 9 replica's of Sheet1.xlsx and name them as Sheet2, Sheet3, Sheet4, .......... Sheet10
3. Open the sheet Consolidated.xlsm and see the button i have added called "Pull Data".
Now write down the code by adding a Module in that excel sheet from the code window.
4. Write a code that will open each of these sheets (Sheet1, Sheet2, Sheet3, Sheet4, .......... so on) one at a time and will copy the data from these sheets to the Consolidated.xlsm sheet.
5. Make sure that the data is appended(and not overwritten) from the multiple sheets (Sheet1, Sheet2, Sheet3). that is once you paste the data from sheet1 to Consolidated.xlsm then the Sheet2 data will be pasted at the end and after that sheet3 data will be pasted and so on..
6. In this way at the end we will have all the data from Sheet1, Sheet2, Sheet3...in the consolidated sheet.
7. The Division column in the Consolidated sheet will have the value of first row in these multiple sheets. So after making the replicas of Sheet1, please change the value in first row (Range A1) to any other value to avoid the confusion.
8. I have highlighted the data for two sheets in yellow and grey color in the consolidated sheet. Thus you will get an idea of what needs to be done.

[Naveed Raza]

please share the both workbooks

[Amol1988]

Hi, thanks for your reply...
I have attached both the files...
Thanks
Amol

[HaHoBe]

Hi, Amol1988,

have a look at WBs to 1 Sheet or Merge data from all workbooks in a folder to get you started.

Besides the description looks like some sort of homework to me.

Ciao,
Holöger

[Amol1988]

Please anyone can help me to solve above all issue...

[Amol1988]

i have done some coding but it will only copy some amount of data to another workbook.I want to copy whole data of sheet1 into another workbook without overwrite...please check my below code..

Sub GatherDataMacro_for_bkutkut()
    
    Dim strPaths As Variant: strPaths = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", _
                                                                    MultiSelect:=True)
    If Not IsArray(strPaths) Then Exit Sub
    Application.ScreenUpdating = False
    
    Dim wsDest As Worksheet: Set wsDest = ActiveWorkbook.Sheets("Sheet2")
    Dim wbData As Workbook, wbIndex As Long, rngDest As Range
    
    For wbIndex = UBound(strPaths) To 1 Step -1
        Set wbData = Workbooks.Open(strPaths(wbIndex))
        If Trim(wsDest.[B7].Value) = vbNullString Then
            Set rngDest = wsDest.[B7]
        Else
            Set rngDest = wsDest.[B6].End(xlDown).Offset(1, 0)
        End If
        rngDest.Resize(1, 17).Value = wbData.Sheets("Sheet1").[A1:Q1].Value
        wbData.Close False
    Next wbIndex
    
    Application.ScreenUpdating = True
    
End Sub

[Naveed Raza]

Hi Amol

please find the attached Consoldate Macro File.

- Open the File and click on Pull Data Button and it will ask you select the files then select whatever the files you want to consoldate.

Sub Pull_data()
Dim FPath As Variant: FPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", _
                                                                    MultiSelect:=True)
If Not IsArray(FPath) Then Exit Sub

Dim CSht As Worksheet: Set CSht = ThisWorkbook.Sheets("Sheet2")
CSht.Range("A2:A" & CSht.Cells(CSht.Rows.Count, 1).End(xlUp).Row + 1).ClearContents
Dim FSht As Worksheet, LR As Long, FName As Long, Wb As Workbook
For FName = UBound(FPath) To 1 Step -1
    LR = CSht.Cells(CSht.Rows.Count, 1).End(xlUp).Row + 1
    Set Wb = Workbooks.Open(FPath(FName))
    Set FSht = Wb.Sheets("Sheet1")
    FSht.Range("A3:A" & FSht.Cells(FSht.Rows.Count, 1).End(xlUp).Row).EntireRow.Copy
        CSht.Range("A" & LR).PasteSpecial xlPasteAll
    Application.CutCopyMode = False
    Wb.Close False
Next
CSht.Select
CSht.Range("A1").Select
MsgBox "Done !"
End Sub

[Amol1988]

Thanks Navved .... i used that code ..its work fine

[Naveed Raza]

Hi Amol

please use code tages while posting codes its against the Forum rule, please edit your last post..