PDA

View Full Version : Solved: Merge data as value without formatting



halimi1306
04-13-2011, 07:31 PM
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
04-13-2011, 07:59 PM
Change these lines:

Worksheets(SheetCtr).Range("D25:S" & LastShtRow).Copy _
Destination:=Worksheets(4).Range("F" & Last1Row + 1)

to:

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

halimi1306
04-13-2011, 09:04 PM
hi mbarron,

I got this error, 1004

macropod
04-14-2011, 12:35 AM
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
04-14-2011, 03:29 AM
Thanks a lots Paul and mBarron for your help.
I should remarks this thread as solved.

:):):)