Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
![]()
Hello,
I am trying to modify Ron DeBruin's "Merge Cells from all or some worksheets into one Mastersheet" function but need to have a special condition inserted and I am not sure how to do it. I am not very good with VBA, but have had some success with modifying code. Specifically, I want to be able to copy data that appears in columns A - AH provided that column B has a value greater than zero. Currently I have in column B either; a 5 digit number, the word "Enter", or it is null. I only want to copy rows that have the five digital number (which is why I am thinking greater than zero). I have seven worksheets that I will be copying data from. I have pasted Ron's code below in the event it is an easy tweak. Thanks in advance. 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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
How do you merge worksheets | Excel Worksheet Functions | |||
How can I merge two worksheets together | Excel Worksheet Functions | |||
Ron DeBruin's Sendmail | Excel Discussion (Misc queries) | |||
Merge Worksheets | Excel Discussion (Misc queries) | |||
Merge Worksheets | Excel Discussion (Misc queries) |