• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA for consolidating text from all sheets into one

A

Amit Punia

Member
Need a VBA code which can copy text/numbers/anything from all the cells of first column of all the sheets and paste them in the last sheet in column A. If there are blank cells in between then those blank cells should be deleted in the last sheet called "Consolidated". Like in the first sheet called "Cover" is having numbers in column A starting from cell A4 and the number is 49. So the VBA should copy everything from column A of this sheet and it should paste it in the last sheet called "Consolidated. Once done it should delete all the blank cells in between and then start copying the data from column A of next sheet called "Disclaimer" and paste the data in column A of "Consolidated" sheet just below the existing data.

I checked online and merged 2-3 codes together to do the same but it's not giving out the desired output. Can anybody modify the below mentioned code or provide a new sets of codes for this task.

Code: 
Sub Create_Summary()

Dim sh As Worksheet, sumSht As Worksheet
Dim i As Long

Set sumSht = Sheets("Consolidated")
sumSht.Move after:=Worksheets(Worksheets.Count)

For i = 1 To Worksheets.Count - 1 ' once you moved "Consolidated" sheet as the workbook last one, you skip it by limiting loop to the penultimate sheets index
    Worksheets(i).Range("A:A").Copy Destination:=sumSht.Cells(1, sumSht.Columns.Count).End(xlToLeft).Offset(, 1) ' qualify all destination references to "Consolidated" sheet
Next i
sumSht.Columns(1).Delete ' "Consolidated" sheet first column gest skipped by the above loop, so delete it

On Error Resume Next


Dim j As Long, ws As Worksheet, rngCopy As Range, rngEnd As Range
Set ws = ActiveSheet
Do Until ws.Cells(1, 2).Value = ""
    Set rngCopy = ws.Range("B2", ws.Cells(ws.Rows.Count, "B").End(xlUp))
    Set rngEnd = ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1, 0)
    rngEnd.Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Value
    rngCopy.EntireColumn.Delete
Loop

Worksheets("Consolidated").Range("A:A").Select
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Range("A1").Select

End Sub


The file is also attached in this post. I searched the code keeping in mind that Consolidated sheet already exists in the workbook. Is it possible the the code automatically adds a new worksheet, renames it "Consolidated" and pastes all the data from column A of all the other sheets.

Thanks in advance :)
 

Attachments

  • All data from Column A into one sheet.xlsm
    96.8 KB · Views: 3
Last edited by a moderator:
Hi @Hui , Thanks for sharing the links with me. I looked at one of the code from this link - http://www.rondebruin.nl/win/s3/win002.htm

The only problem with this code is that the coder tries to find the last row using LastRow code but it gives out error saying "Compile error: Sub or Function not defined".

Just want to understand whether we can simply use the last row code instead of the function to do this task.
The Code is-

Code: 
Sub CopyRangeFromMultiWorksheets()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range

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

'Delete the sheet "RDBMergeSheet" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "RDBMergeSheet"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "RDBMergeSheet"

'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> DestSh.Name Then

'Find the last row with data on the DestSh
Last = LastRow(DestSh)

'Fill in the range that you want to copy
Set CopyRng = sh.Range("A1:G1")

'Test if there enough rows in the DestSh to copy all the data
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If

'This example copies values/formats, if you only want to copy the
'values or want to copy everything look at the example below this macro
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With

'Optional: This will copy the sheet name in the H column
DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Name

End If
Next

ExitTheSub:

Application.Goto DestSh.Cells(1)

'AutoFit the column width in the DestSh sheet
DestSh.Columns.AutoFit

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
>>> Use CODE -tags <<<
 
Last edited by a moderator:
You must log in or register to reply here.
Back
Top