Macro not copying (or pasting?) content of all cells
On May 5, 12:10*pm, wrote:
On May 5, 11:40*am, "Nigel" wrote:
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
wrote in message
...
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???- Hide quoted text -
- 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: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.
|