Hi all,
I am trying to copy and paste cells in my workbooks into the master excluding those rows that are hidden. I tried using the special cells code but it only copied the formats of the cells and not the contents. Am i missing something?
My code is as follows:
I am trying to copy and paste cells in my workbooks into the master excluding those rows that are hidden. I tried using the special cells code but it only copied the formats of the cells and not the contents. Am i missing something?
My code is as follows:
VBA Code:
Sub ImportSuccessionData()
Dim Path As String 'string variable to hold the path to look through
Dim FileName As String 'temporary filename string variable
Dim tWB As Workbook 'temporary workbook (each in directory)
Dim tWS As Worksheet 'temporary worksheet variable
Dim mWB As Workbook 'master workbook
Dim aWS As Worksheet 'active sheet in master workbook
Dim RowCount As Long 'Rows used on master sheet
Dim uRange As Range 'usedrange for each temporary sheet
Dim LastRowUsed As Long
Dim destrange As Range
Dim calcmode As Long
'***** Set folder to cycle through *****
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFolderPicker) 'Dialogue to select folder wtih files
.AllowMultiSelect = False
.Show
On Error Resume Next
Path = .SelectedItems(1)
Err.Clear
On Error GoTo 0
End With
Application.EnableEvents = False 'turn off events
Application.ScreenUpdating = False 'turn off screen updating
Set mWB = ActiveWorkbook 'select workbook variable as open file
mWB.Sheets("Succession Plan").Select 'select worksheet to copy data into
Set aWS = mWB.ActiveSheet 'set active sheet variable to data sheet
LastRowUsed = aWS.Cells(aWS.Rows.Count, "A").End(xlUp).Row
If Right(Path, 1) <> Application.PathSeparator Then 'if path doesnt end in "\"
Path = Path & Application.PathSeparator 'add "\"
FileName = dir(Path & "*.xl*", vbNormal) 'set first file's name to filename variable
Do Until FileName = "" 'loop until all files have been parsed
If Path <> ThisWorkbook.Path Or FileName <> ThisWorkbook.Name Then
Set tWB = Workbooks.Open(FileName:=Path & FileName) 'open file, set to tWB variable
ActiveWorkbook.Unprotect Password:="star2020"
Set tWS = tWB.Sheets("Succession Plan")
Set uRange = tWS.Range("A1:T30") 'set used range
If RowCount + uRange.Rows.Count > 65536 Then 'if the used range wont fit on the sheet
aWS.Columns.AutoFit 'autofit mostly-used worksheet's columns
Set aWS = mWB.Sheets.Add(after:=aWS) 'add a new sheet that will accommodate data
RowCount = 0 'reset RowCount variable
End If
uRange.SpecialCells(xlCellTypeVisible).Copy
Set destrange = aWS.Range("A" & RowCount + LastRowUsed)
With destrange
.PasteSpecial xlPasteValuesAndNumberFormats
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteColumnWidths
Application.CutCopyMode = False
End With
RowCount = RowCount + uRange.Rows.Count 'increase rowcount accordingly
tWB.Close False 'close temporary workbook without saving
End If
FileName = dir() 'set next file's name to FileName variable
Loop
mWB.Sheets("Succession Plan").Select 'select fourth data sheet on master workbook
'aWS.Protect ("9a9b9c")
Application.EnableEvents = True 're-enable events
Application.ScreenUpdating = True 'turn screen updating back on
ExitTheSub:
'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlAutomatic
End With
End If
End Sub
