Problem with VBA Macro Consolidating data
 

Hello, can someone help me identify the modifications I need to make
to the code below?
In the code below it will copy the data from the external workbook and
paste it into my workbook as long as the tab/sheet names match.
Problem is, the external workbook has 3 tabs the worksheet I'm running
it in only has/needs one tab, so I get a "subscript out of range". If
my worksheet has 3 identical named tabs then the code works fine. But
I can only have 1 tab in this workbook since I'm importing it into a
different application that only accepts .Csv w/one tab. I'm guessing
my code needs to be edited so that it only searches for an identically
named tab/sheet in the external workbook if it exist's in my workbook,
right now it seems to be doing the opposite.

Sub consolidate()
' Will consolidate Mulitple Sheets
' from Multiple Files onto the same named sheets
' Assumes that all data starts in cell A1 and
' is contiguous, with no blanks in column A


With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With


With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = "C:\test\Previous Day"
.SearchSubFolders = True 'Change to true if needed
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
Set Basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
Set myBook = Workbooks.Open(.FoundFiles(i))
For Each mySheet In myBook.Worksheets
mySheet.Activate
Range("A1").CurrentRegion.Copy _
Basebook.Worksheets(mySheet.Name).Range("A65536"). End(xlUp).Offset(0,
0)
Next mySheet
myBook.Close
Next i
End If
End With


With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

Problem with VBA Macro Consolidating data
 

Try something like this.

Sub consolidate()
' Will consolidate Mulitple Sheets
' from Multiple Files onto the same named sheets
' Assumes that all data starts in cell A1 and
' is contiguous, with no blanks in column A


With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With


With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = "C:\test\Previous Day"
.SearchSubFolders = True 'Change to true if needed
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
Set Basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
Set myBook = Workbooks.Open(.FoundFiles(i))
For Each mysheet In myBook.Worksheets
found = False
For Each ws In Basebook.Worksheets
If mysheet.Name = ws.Name Then
found = True
Exit For
End If
Next ws

If found = True Then
mysheet.Activate
Range("A1").CurrentRegion.Copy _
Basebook.Worksheets(mysheet.Name). _
Range("A65536").End(xlUp).Offset(0, 0)
End If
Next mysheet
myBook.Close
Next i
End If
End With


With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub


"GTVT06" wrote:

Hello, can someone help me identify the modifications I need to make
to the code below?
In the code below it will copy the data from the external workbook and
paste it into my workbook as long as the tab/sheet names match.
Problem is, the external workbook has 3 tabs the worksheet I'm running
it in only has/needs one tab, so I get a "subscript out of range". If
my worksheet has 3 identical named tabs then the code works fine. But
I can only have 1 tab in this workbook since I'm importing it into a
different application that only accepts .Csv w/one tab. I'm guessing
my code needs to be edited so that it only searches for an identically
named tab/sheet in the external workbook if it exist's in my workbook,
right now it seems to be doing the opposite.

Sub consolidate()
' Will consolidate Mulitple Sheets
' from Multiple Files onto the same named sheets
' Assumes that all data starts in cell A1 and
' is contiguous, with no blanks in column A


With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With


With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = "C:\test\Previous Day"
.SearchSubFolders = True 'Change to true if needed
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
Set Basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
Set myBook = Workbooks.Open(.FoundFiles(i))
For Each mySheet In myBook.Worksheets
mySheet.Activate
Range("A1").CurrentRegion.Copy _
Basebook.Worksheets(mySheet.Name).Range("A65536"). End(xlUp).Offset(0,
0)
Next mySheet
myBook.Close
Next i
End If
End With


With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

Problem with VBA Macro Consolidating data
 

Thanks! that works

On Aug 15, 11:38 am, Joel wrote:
Try something like this.

Sub consolidate()
' Will consolidate Mulitple Sheets
' from Multiple Files onto the same named sheets
' Assumes that all data starts in cell A1 and
' is contiguous, with no blanks in column A

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = "C:\test\Previous Day"
.SearchSubFolders = True 'Change to true if needed
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
Set Basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
Set myBook = Workbooks.Open(.FoundFiles(i))
For Each mysheet In myBook.Worksheets
found = False
For Each ws In Basebook.Worksheets
If mysheet.Name = ws.Name Then
found = True
Exit For
End If
Next ws

If found = True Then
mysheet.Activate
Range("A1").CurrentRegion.Copy _
Basebook.Worksheets(mysheet.Name). _
Range("A65536").End(xlUp).Offset(0, 0)
End If
Next mysheet
myBook.Close
Next i
End If
End With

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub



"GTVT06" wrote:
Hello, can someone help me identify the modifications I need to make
to the code below?
In the code below it will copy the data from the external workbook and
paste it into my workbook as long as the tab/sheet names match.
Problem is, the external workbook has 3 tabs the worksheet I'm running
it in only has/needs one tab, so I get a "subscript out of range". If
my worksheet has 3 identical named tabs then the code works fine. But
I can only have 1 tab in this workbook since I'm importing it into a
different application that only accepts .Csv w/one tab. I'm guessing
my code needs to be edited so that it only searches for an identically
named tab/sheet in the external workbook if it exist's in my workbook,
right now it seems to be doing the opposite.

Sub consolidate()
' Will consolidate Mulitple Sheets
' from Multiple Files onto the same named sheets
' Assumes that all data starts in cell A1 and
' is contiguous, with no blanks in column A

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = "C:\test\Previous Day"
.SearchSubFolders = True 'Change to true if needed
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
Set Basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
Set myBook = Workbooks.Open(.FoundFiles(i))
For Each mySheet In myBook.Worksheets
mySheet.Activate
Range("A1").CurrentRegion.Copy _
Basebook.Worksheets(mySheet.Name).Range("A65536"). End(xlUp).Offset(0,
0)
Next mySheet
myBook.Close
Next i
End If
End With

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub- Hide quoted text -

- Show quoted text -

Problem with VBA Macro Consolidating data
 

How can I edit the code so that I can run the macro from within
the .xls workbook but have the script run on the .cvs workbook?

On Aug 15, 11:38 am, Joel wrote:
Try something like this.

Sub consolidate()
' Will consolidate Mulitple Sheets
' from Multiple Files onto the same named sheets
' Assumes that all data starts in cell A1 and
' is contiguous, with no blanks in column A

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = "C:\test\Previous Day"
.SearchSubFolders = True 'Change to true if needed
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
Set Basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
Set myBook = Workbooks.Open(.FoundFiles(i))
For Each mysheet In myBook.Worksheets
found = False
For Each ws In Basebook.Worksheets
If mysheet.Name = ws.Name Then
found = True
Exit For
End If
Next ws

If found = True Then
mysheet.Activate
Range("A1").CurrentRegion.Copy _
Basebook.Worksheets(mysheet.Name). _
Range("A65536").End(xlUp).Offset(0, 0)
End If
Next mysheet
myBook.Close
Next i
End If
End With

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub



"GTVT06" wrote:
Hello, can someone help me identify the modifications I need to make
to the code below?
In the code below it will copy the data from the external workbook and
paste it into my workbook as long as the tab/sheet names match.
Problem is, the external workbook has 3 tabs the worksheet I'm running
it in only has/needs one tab, so I get a "subscript out of range". If
my worksheet has 3 identical named tabs then the code works fine. But
I can only have 1 tab in this workbook since I'm importing it into a
different application that only accepts .Csv w/one tab. I'm guessing
my code needs to be edited so that it only searches for an identically
named tab/sheet in the external workbook if it exist's in my workbook,
right now it seems to be doing the opposite.

Sub consolidate()
' Will consolidate Mulitple Sheets
' from Multiple Files onto the same named sheets
' Assumes that all data starts in cell A1 and
' is contiguous, with no blanks in column A

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = "C:\test\Previous Day"
.SearchSubFolders = True 'Change to true if needed
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
Set Basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
Set myBook = Workbooks.Open(.FoundFiles(i))
For Each mySheet In myBook.Worksheets
mySheet.Activate
Range("A1").CurrentRegion.Copy _
Basebook.Worksheets(mySheet.Name).Range("A65536"). End(xlUp).Offset(0,
0)
Next mySheet
myBook.Close
Next i
End If
End With

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub- Hide quoted text -

- Show quoted text -