Macro not copying (or pasting?) content of all cells

[miatadiablo]

I have had Ron de Bruin's "Merge cells from all or some worksheets
into one Master sheet" macro working successfully on a workbook for a
couple of years now. Suddenly, the macro isn't copying information
from all cells. All rows and columns are being copied/pasted to the
Master Sheet, but it is leaving random cells blank in the master
sheet.

Any ideas???

 

[Nigel]

Without your code impossible to say?

Also if it has worked for 2 years what has changed?

New version of Excel, data structure etc. etc.

 

[miatadiablo]

Without your code impossible to say?

Also if it has worked for 2 years what has changed?

New version of Excel, data structure etc. etc.

--

Regards,
Nigel
(e-mail address removed)







- Show quoted text -

Nothing has changed. Still on Excel 2003, SP3. Structure of
spreadsheets haven't changed, data/data type hasn't changed, cells do
not contain special formatting or formulae. I would think if a change
were the case, why would it copy any of it instead of just some of
it? I appreciate your help!

Code is:

Function LastRow(Sh As Worksheet)
On Error Resume Next
LastRow = Sh.Cells.Find(What:="*", After:=Sh.Range("A1"),
LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows,
SearchDirection:=xlPrevious, MatchCase:=False).Row
On Error GoTo 0
End Function

Function LastCol(Sh As Worksheet)
On Error Resume Next
LastCol = Sh.Cells.Find(What:="*", After:=Sh.Range("A1"),
LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns,
SearchDirection:=xlPrevious, MatchCase:=False).Column
On Error GoTo 0
End Function

Sub CompileAll()
Dim Sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long

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

Application.DisplayAlerts = False
On Error Resume Next

ThisWorkbook.Worksheets("All Data").Delete
On Error GoTo 0

Application.DisplayAlerts = True
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "All Data"
DestSh.Move After:=ThisWorkbook.Worksheets
(ThisWorkbook.Worksheets.Count)

For Each Sh In Sheets(Array("SheetA", "SheetB", "SheetC", "SheetD",
"SheetE"))

If Sh.Name <> DestSh.Name Then
Last = LastRow(DestSh)
shLast = LastRow(Sh)
Sh.UsedRange.Copy DestSh.Cells(Last + 1, "A")
End If

Next

Application.GoTo DestSh.Cells(1)

With Application
..ScreenUpdating = False
..EnableEvents = True
End With
Cells.Select
With Selection
..HorizontalAlignment = xlGeneral
..VerticalAlignment = xlTop
..WrapText = False
..Orientation = 0
..AddIndent = False
..IndentLevel = 0
..ShrinkToFit = False
..ReadingOrder = xlContext
..MergeCells = False
End With

Columns("A:A").ColumnWidth = 11.14
Columns("C:C").ColumnWidth = 33.86
Columns("C:C").ColumnWidth = 39.29
Columns("D").ColumnWidth = 32.29
Columns("E:E").ColumnWidth = 21.43
Columns("F:F").ColumnWidth = 22.29
Selection.AutoFilter

Cells.Replace What:="" & Chr(10) & "", Replacement:="" & Chr(10) & "",
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False,
SearchFormat:=False, ReplaceFormat:=False

Columns("C:C").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=COUNTIF
($C$2:$C$6000,C1)>1"
Selection.FormatConditions(1).Font.ColorIndex = 5

Call CompileSheetEInfo

ActiveWorkbook.Sheets("All Data").Tab.ColorIndex = 6
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True, Password:="xxxx"

End Sub

 

[miatadiablo]

Nothing has changed.  Still on Excel 2003, SP3.  Structure of
spreadsheets haven't changed, data/data type hasn't changed, cells do
not contain special formatting or formulae.  I would think if a change
were the case, why would it copy any of it instead of just some of
it?  I appreciate your help!

Code is:

Function LastRow(Sh As Worksheet)
On Error Resume Next
LastRow = Sh.Cells.Find(What:="*", After:=Sh.Range("A1"),
LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows,
SearchDirection:=xlPrevious, MatchCase:=False).Row
On Error GoTo 0
End Function

Function LastCol(Sh As Worksheet)
On Error Resume Next
LastCol = Sh.Cells.Find(What:="*", After:=Sh.Range("A1"),
LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns,
SearchDirection:=xlPrevious, MatchCase:=False).Column
On Error GoTo 0
End Function

Sub CompileAll()
Dim Sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long

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

Application.DisplayAlerts = False
On Error Resume Next

ThisWorkbook.Worksheets("All Data").Delete
On Error GoTo 0

Application.DisplayAlerts = True
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "All Data"
DestSh.Move After:=ThisWorkbook.Worksheets
(ThisWorkbook.Worksheets.Count)

For Each Sh In Sheets(Array("SheetA", "SheetB", "SheetC", "SheetD",
"SheetE"))

If Sh.Name <> DestSh.Name Then
Last = LastRow(DestSh)
shLast = LastRow(Sh)
Sh.UsedRange.Copy DestSh.Cells(Last + 1, "A")
End If

Next

Application.GoTo DestSh.Cells(1)

With Application
.ScreenUpdating = False
.EnableEvents = True
End With
Cells.Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Columns("A:A").ColumnWidth = 11.14
Columns("C:C").ColumnWidth = 33.86
Columns("C:C").ColumnWidth = 39.29
Columns("D").ColumnWidth = 32.29
Columns("E:E").ColumnWidth = 21.43
Columns("F:F").ColumnWidth = 22.29
Selection.AutoFilter

Cells.Replace What:="" & Chr(10) & "", Replacement:="" & Chr(10) & "",
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False,
SearchFormat:=False, ReplaceFormat:=False

Columns("C:C").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=COUNTIF
($C$2:$C$6000,C1)>1"
Selection.FormatConditions(1).Font.ColorIndex = 5

Call CompileSheetEInfo

ActiveWorkbook.Sheets("All Data").Tab.ColorIndex = 6
   ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True _
        , AllowSorting:=True, AllowFiltering:=True, Password:="xxxx"

End Sub- Hide quoted text -

- Show quoted text -

Nevermind, I found the issue, although I don't know why it's an
issue. The Call CompileSheetEInfo is destroying some of the cells.