Trying to Copy data from folder into 1 file as Sheet

[Shazir]

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

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]

Just duplicate this line

Ws.UsedRange.Offset(-Flg).Copy wsDest.Range("A" & Rows.Count).End(xlUp).Offset(1)

& change it to point at the other sheet.

 

[Shazir]

Just duplicate this line

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]

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.

 

[Shazir]

Thanks well noted.

 

[Fluff]

My pleasure.