Hi
I am using the following code to open a folder, and merge all Excel files found in that folder onto one file, by copying and pasting visible cells only, values only.
I am having a problem in which it doesn't copy and paste ALL data, just data in the rows that contain something in Column A.
I tried modifying the code, but I am having a very hard time getting it to work. Can you help?
Thank you,
Samantha.
Option Explicit
Dim rngData As Range
Sub Merge_Workbooks_Select_Folder()
'run Macro, then select the folder that contains your files
Dim strFolder As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select a Folder"
.AllowMultiSelect = True
.InitialFileName = ThisWorkbook.Path & "\"
.Show
strFolder = .SelectedItems(1)
End With
Dim varFile As Variant
Application.ScreenUpdating = False
varFile = Dir(strFolder & "\*.xls")
Do While varFile <> ""
Set rngData = _
ThisWorkbook.ActiveSheet.Range("a" & Rows.Count).End(xlUp).Offset(1)
Merge strFolder & "\" & varFile
varFile = Dir()
Loop
Application.ScreenUpdating = False
End Sub
Sub Merge(ByVal strFileName As String)
Dim lngEndRow As Long, lngRow As Long
Dim ws As Worksheet, shp As Shape
Workbooks.Open strFileName
For Each ws In ActiveWorkbook.Worksheets
'ws.Rows(1).Insert
'ws.Columns("AA").Insert
lngEndRow = ws.Range("A65536").End(xlUp).Row
'ws.Range("AA2:AA" & lngEndRow).FormulaR1C1 = "=CountA(RC1:RC[-1])"
'ws.Range("A1:AA" & lngEndRow).AutoFilter Field:=13, Criteria1:="<>0"
ws.Range("A2:AA" & lngEndRow).SpecialCells(xlCellTypeVisible).Copy
rngData.PasteSpecial xlPasteValues
For Each shp In ActiveSheet.Shapes
shp.Delete
Next shp
Set rngData = ThisWorkbook.ActiveSheet.Range("A" & _
ThisWorkbook.ActiveSheet.Range("A65536").End(xlUp).Row).Offset(1, 0)
Next ws
Application.DisplayAlerts = False
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub
I am using the following code to open a folder, and merge all Excel files found in that folder onto one file, by copying and pasting visible cells only, values only.
I am having a problem in which it doesn't copy and paste ALL data, just data in the rows that contain something in Column A.
I tried modifying the code, but I am having a very hard time getting it to work. Can you help?
Thank you,
Samantha.
Option Explicit
Dim rngData As Range
Sub Merge_Workbooks_Select_Folder()
'run Macro, then select the folder that contains your files
Dim strFolder As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select a Folder"
.AllowMultiSelect = True
.InitialFileName = ThisWorkbook.Path & "\"
.Show
strFolder = .SelectedItems(1)
End With
Dim varFile As Variant
Application.ScreenUpdating = False
varFile = Dir(strFolder & "\*.xls")
Do While varFile <> ""
Set rngData = _
ThisWorkbook.ActiveSheet.Range("a" & Rows.Count).End(xlUp).Offset(1)
Merge strFolder & "\" & varFile
varFile = Dir()
Loop
Application.ScreenUpdating = False
End Sub
Sub Merge(ByVal strFileName As String)
Dim lngEndRow As Long, lngRow As Long
Dim ws As Worksheet, shp As Shape
Workbooks.Open strFileName
For Each ws In ActiveWorkbook.Worksheets
'ws.Rows(1).Insert
'ws.Columns("AA").Insert
lngEndRow = ws.Range("A65536").End(xlUp).Row
'ws.Range("AA2:AA" & lngEndRow).FormulaR1C1 = "=CountA(RC1:RC[-1])"
'ws.Range("A1:AA" & lngEndRow).AutoFilter Field:=13, Criteria1:="<>0"
ws.Range("A2:AA" & lngEndRow).SpecialCells(xlCellTypeVisible).Copy
rngData.PasteSpecial xlPasteValues
For Each shp In ActiveSheet.Shapes
shp.Delete
Next shp
Set rngData = ThisWorkbook.ActiveSheet.Range("A" & _
ThisWorkbook.ActiveSheet.Range("A65536").End(xlUp).Row).Offset(1, 0)
Next ws
Application.DisplayAlerts = False
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub
