Solved: Merge data as value without formatting

[halimi1306]

Hi pals,

Could some one help me with my code. I want data from other sheets to be merge in master sheet as value only without formating. The code below return data to master sheet along with formating.

Code:

Sub AllDataToForthSheet()
    Dim SheetCtr As Double
    Dim Last1Row As Double
    Dim LastShtRow As Double
    For SheetCtr = 5 To ActiveWorkbook.Sheets.Count
        LastShtRow = Worksheets(SheetCtr).Cells(Rows.Count, "D").End(xlUp).Row
        If Worksheets(SheetCtr).Cells(Rows.Count, "J").End(xlUp).Row > LastShtRow Then
            LastShtRow = Worksheets(SheetCtr).Cells(Rows.Count, "G").End(xlUp).Row
        End If
 
        Last1Row = Worksheets(4).Cells(Rows.Count, "F").End(xlUp).Row
        If Worksheets(4).Cells(Rows.Count, "G").End(xlUp).Row > Last1Row Then
            Last1Row = Worksheets(4).Cells(Rows.Count, "J").End(xlUp).Row
        End If
 
        Worksheets(SheetCtr).Range("D25:S" & LastShtRow).Copy _
        Destination:=Worksheets(4).Range("F" & Last1Row + 1)
 
    Next SheetCtr
End Sub 

[mbarron]

Change these lines:

[VBA]Worksheets(SheetCtr).Range("D25:S" & LastShtRow).Copy _
Destination:=Worksheets(4).Range("F" & Last1Row + 1)
[/VBA]
to:
[VBA]
Worksheets(SheetCtr).Range("D25:S" & LastShtRow).Copy
Worksheets(4).Range("F" & Last1Row + 1).PasteSpecial xlPasteValues
'add this line to turn off the 'copy marching ants'
Application.CutCopyMode = False

[/VBA]

[halimi1306]

hi mbarron,

I got this error, 1004

[macropod]

The following works for me:

Sub AllDataToForthSheet()
Application.ScreenUpdating = False
Dim SheetCtr As Double
Dim Last1Row As Double
Dim LastShtRow As Double
With ActiveWorkbook
  For SheetCtr = 5 To .Sheets.Count
    With .Worksheets(SheetCtr)
      LastShtRow = .Cells(Rows.Count, "D").End(xlUp).Row
      If .Cells(Rows.Count, "J").End(xlUp).Row > LastShtRow Then
        LastShtRow = .Cells(Rows.Count, "G").End(xlUp).Row
      End If
    End With
    With .Worksheets(4)
      Last1Row = .Cells(Rows.Count, "F").End(xlUp).Row
      If .Cells(Rows.Count, "G").End(xlUp).Row > Last1Row Then
        Last1Row = .Cells(Rows.Count, "J").End(xlUp).Row
      End If
    End With
    .Worksheets(SheetCtr).Range("D25:S" & LastShtRow).Copy
    .Worksheets(4).Range("F" & Last1Row + 1).PasteSpecial xlPasteValues
  Next SheetCtr
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

[halimi1306]

Thanks a lots Paul and mBarron for your help.
I should remarks this thread as solved.