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
 

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Someone can please help me in this regard.
 
Upvote 0
Do you want to create a new sheet for the data?
 
Upvote 0
In that case does sheet1 need to be cleared before copying, or will it already be empty?
 
Upvote 0
Yes, It will be cleared the existing data from Sheet1.
 
Upvote 0
Ok, how about
VBA Code:
Sub Shazir()
   Dim Fldr As String, Fname As String
   Dim wsDest As Worksheet, Ws As Worksheet
   Dim Flg As Boolean
   
   Application.ScreenUpdating = False
   Set wsDest = ThisWorkbook.Sheets("Sheet1")
   wsDest.UsedRange.Clear
   With Application.FileDialog(4)
      .AllowMultiSelect = False
      If .Show Then Fldr = .SelectedItems(1) & "\"
   End With
   Fname = Dir(Fldr & "*.xls*")
   Do While Fname <> ""
      With Workbooks.Open(Fldr & Fname)
         For Each Ws In .Worksheets
            Ws.UsedRange.Offset(-Flg).Copy wsDest.Range("A" & Rows.Count).End(xlUp).Offset(1)
            Flg = True
         Next Ws
         .Close False
      End With
      Fname = Dir
   Loop
End Sub
 
Upvote 0
Solution
You're welcome & thanks for the feedback.
 
Upvote 0

Fluff

Sir, if its possible than please edit the code bit.

that i want to paste the same data in Sheet2 as well.

When i run the code data should be paste in two files Sheet1 and Sheet2.

Is it possible ?
 
Upvote 0

Forum statistics

Threads
1,213,517
Messages
6,114,089
Members
448,548
Latest member
harryls

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
Back
Top