Do While Loop Data to be Copied

Shazir

Board Regular
Joined
Jul 28, 2020
Messages
62
Office Version
  1. 365
Platform
  1. Windows
Using below code which is giving accurate and false result.

The problem is that when i apply the CombineData code for single file it works perfectly and makes MasterSheet as first sheet which comes before each sheet on the left hand side.

When i use Do While Loop code for some files by selecting a folder some files give accurate result and some give wrong that means MasterSheet is create at the end of the sheets and if the file has 10 sheets it will paste 10 sheets data twice. I do not know what is wrong with the code.

Looking for a solution.


Sub CombineData()
Dim I As Long
Dim xRg As Range
On Error Resume Next
Worksheets.Add Sheets(1)
ActiveSheet.Name = "MasterSheet"

For I = 2 To Sheets.Count
Set xRg = Sheets(1).UsedRange

If I > 2 Then
Set xRg = Sheets(1).Cells(xRg.Rows.Count + 1, 1)
End If
Sheets(I).Activate
ActiveSheet.UsedRange.Copy xRg
Next
End Sub


VBA Code:
Sub Copydata()

Dim xFd As FileDialog
Dim xFdItem As String
Dim xFileName As String
Dim wbk As Workbook
Dim sht As Worksheet
Dim Last_Row As Long

Set xFd = Application.FileDialog(msoFileDialogFolderPicker)

If xFd.Show Then
    xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
Else
    Beep
    Exit Sub
End If

xFileName = Dir(xFdItem & "*.xlsx")

Do While xFileName <> ""
Set wbk = Workbooks.Open(xFdItem & xFileName)
Sheets.Add.Name = "MasterSheet"
Set ms = Sheets("MasterSheet")
    For Each sht In wbk.Sheets
            If sht.Name <> "Master Sheet" Then
                ms.UsedRange
                Last_Row = ms.UsedRange.Rows(ms.UsedRange.Rows.Count).Row
                sht.UsedRange.Copy ms.Range("A" & Last_Row + 1)
            End If
    Next sht
wbk.Close SaveChanges:=True
xFileName = Dir
Loop

End Sub
 

Some videos you may like

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
1,090
Office Version
  1. 2013
Platform
  1. Windows
Not sure about the result but try ...


Rich (BB code):
Sub Copydata()

Dim xFd As FileDialog
Dim xFdItem As String
Dim xFileName As String
Dim wbk As Workbook
Dim sht As Worksheet, ms As Worksheet
Dim Last_Row As Long

Set xFd = Application.FileDialog(msoFileDialogFolderPicker)

If xFd.Show Then
    xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
Else
    Beep
    Exit Sub
End If

xFileName = Dir(xFdItem & "*.xlsx")

Do While xFileName <> ""
    Set wbk = Workbooks.Open(xFdItem & xFileName)
    Set ms = wbk.Sheets.Add(Before:=wbk.Sheets(1))
    ms.Name = "MasterSheet"
        For Each sht In wbk.Sheets
            If sht.Name <> ms.Name Then
                Last_Row = ms.UsedRange.Rows(ms.UsedRange.Rows.Count).Row
                sht.UsedRange.Copy ms.Range("A" & Last_Row + 1)
            End If
        Next sht
    wbk.Close SaveChanges:=True
    xFileName = Dir
Loop

End Sub
 
Solution

Watch MrExcel Video

Forum statistics

Threads
1,113,903
Messages
5,544,966
Members
410,646
Latest member
jojoseb
Top