Trying to Copy data from folder into 1 file as Sheet

Shazir

Banned - Rules violations
Joined
Jul 28, 2020
Messages
94
Office Version
  1. 365
Platform
  1. Windows
Hi, I hope everything is going well.

I have been finding a code which open the pop up window to select the folder where multiple files are placed.

Then code will select the folder and copy the data from all sheets (whatever the sheet name is) into the sheet where from code is being run and it should be paste as values.

all files header should be deleted except 1st file so headers could not be repeated multiple times according number of files.

Looking for positive response Thanks

VBA Code:
Sub copydata()
    Dim xRg As Range
    Dim xSelItem As Variant
    Dim xFileDlg As FileDialog
    Dim xFileName, xSheetName, xRgStr As String
    Dim xBook, xWorkBook As Workbook
    Dim xSheet As Worksheet
    On Error Resume Next
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    xSheetName = "Sheet1"
    xRgStr = "A1:D4"
    Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    With xFileDlg
        If .Show = -1 Then
            xSelItem = .SelectedItems.Item(1)
            Set xWorkBook = ThisWorkbook
            Set xSheet = xWorkBook.Sheets("New Sheet")
            If xSheet Is Nothing Then
                xWorkBook.Sheets.Add(after:=xWorkBook.Worksheets(xWorkBook.Worksheets.Count)).Name = "New Sheet"
                Set xSheet = xWorkBook.Sheets("New Sheet")
            End If
            xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
            If xFileName = "" Then Exit Sub
            Do Until xFileName = ""
               Set xBook = Workbooks.Open(xSelItem & "\" & xFileName)
                Set xRg = xBook.Worksheets(xSheetName).Range(xRgStr)
                xRg.Copy xSheet.Range("A65536").End(xlUp).Offset(1, 0)
                xFileName = Dir()
                xBook.Close
            Loop
        End If
    End With
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,311
Office Version
  1. 365
Platform
  1. Windows
Just duplicate this line
VBA Code:
Ws.UsedRange.Offset(-Flg).Copy wsDest.Range("A" & Rows.Count).End(xlUp).Offset(1)
& change it to point at the other sheet.
 

Some videos you may like

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

Shazir

Banned - Rules violations
Joined
Jul 28, 2020
Messages
94
Office Version
  1. 365
Platform
  1. Windows
Just duplicate this line
VBA Code:
Ws.UsedRange.Offset(-Flg).Copy wsDest.Range("A" & Rows.Count).End(xlUp).Offset(1)
& change it to point at the other sheet.
Sir i did this but data is still pasting in Sheet1 as duplicate.

right now code is pasting data in Sheet1 All i want is either it should create a copy with Sheet2 name or should paste similar data in Sheet2 as code is working for Sheet1
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,311
Office Version
  1. 365
Platform
  1. Windows
In that case just stick with the code I supplied & at the end of it create a copy of sheet1. Then you have two sheets with the data.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,346
Messages
5,601,078
Members
414,426
Latest member
fraru

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top