EXCEL macro problem please help!

ryguy551 · #1 05-22-2014, 12:31 PM

Hello i am trying to make a macro that will allow me to merge specific spreadsheets with specific names. As you will see in my code one of the sheets names is planting a. when i run the macro with just planting a it works perfectly but when i try to add another if statement to get multiple sheets to merge i get errors here is the code please help with what i can add.

Code:

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 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 summary sheet if it exists.
    Application.DisplayAlerts = False 
    On Error Resume Next 
    ActiveWorkbook.Worksheets("RDBMergeSheet").Delete 
    On Error Goto 0 
    Application.DisplayAlerts = True 
     
     ' Add a new summary worksheet.
    Set DestSh = ActiveWorkbook.Worksheets.Add 
    DestSh.Name = "RDBMergeSheet" 
     
     ' Loop through all worksheets and copy the data to the
     ' summary worksheet.
    For Each sh In ActiveWorkbook.Worksheets 
        If LCase(Left(sh.Name, 10)) = "planting a" Then 
             
             ' Find the last row with data on the summary worksheet.
            Last = LastRow(DestSh) 
             
             ' Specify the range to place the data.
            Set CopyRng = sh.Rows("1:500") 
             
             ' Test to see whether there are enough rows in the summary
             ' worksheet to copy all the data.
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then 
                MsgBox "There are not enough rows in the " & _ 
                "summary worksheet to place the data." 
                Goto ExitTheSub 
            End If 
             ' This statement copies values and formats from each
             ' worksheet.
            CopyRng.Copy 
            With DestSh.Cells(Last + 1, "A") 
                .PasteSpecial xlPasteValues 
                .PasteSpecial xlPasteFormats 
                Application.CutCopyMode = False 
            End With 
             
             ' Optional: This statement will copy the sheet
             ' name in the H column.             
        End If          
    Next 
     
ExitTheSub: 
     
    Application.Goto DestSh.Cells(1) 
     
     ' AutoFit the column width in the summary sheet.
    DestSh.Columns.AutoFit 
     
    With Application 
        .ScreenUpdating = True 
        .EnableEvents = True 
    End With 
End Sub

This code works fine but i want to add another if statement to detect other names of sheets thanks!

macropod · #2 05-22-2014, 03:38 PM

The simplest way, assuming each of the extra sheets is to be processed the same way as your existing one, it to add however many OR conditions you need to this line:
If LCase(Left(sh.Name, 10)) = "planting a" Then
For example:
If LCase(Left(sh.Name, 10)) = "planting a" Or LCase(Left(sh.Name, 10)) = "planting b" Then

PS: When posting code, please use the code tags. They're on the 'Go Advanced' tab below the Reply box.

BobBridges · #3 05-22-2014, 03:58 PM

Quote:

Originally Posted by ryguy551

i am trying to make a macro that will allow me to merge spreadsheets with specific names....one of the sheet's name is "planting a". when i run the macro with just "planting a" it works perfectly, but when i try to add another If statement, to get multiple sheets to merge, i get errors. here is the code. please help with what i can add....This code works fine but i want to add another if statement to detect other names of sheets thanks!

Well, rather that try to work out the meaning of the whole module let me see whether I can focus on just the part you need help with:

Code:

For Each sh In ActiveWorkbook.Worksheets
  If LCase(Left(sh.Name, 10)) = "planting a" Then
    Last = LastRow(DestSh)
    Set CopyRng = sh.Rows("1:500") 'specify the range to place the data

    ' Test to see whether there are enough rows in the summary
    ' worksheet to copy all the data.
    If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
      MsgBox "There are not enough rows in the summary worksheet to place the data."
      Goto ExitTheSub
      End If

    ' Copy values and formats from each worksheet.
    CopyRng.Copy
    With DestSh.Cells(Last + 1, "A")
      .PasteSpecial xlPasteValues
      .PasteSpecial xlPasteFormats
      Application.CutCopyMode = False
      End With

    End If          
  Next

This, you say, works fine, but when you add another If statement you get errors. But in that case, we don't need to see the code that works fine; we need to see the code that doesn't work, and hear what errors it generates.

But maybe I'm onto something already: Why do you need another If statement? Why do you need even the first one? Don't you want to copy the data from all the other worksheets to the new summary? Why do you care what the source worksheet name is?

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Problem with macro	MS baby	Excel Programming	4	03-31-2014 02:47 PM
Problem with macro	tmill29	Excel Programming	1	06-08-2013 09:59 AM
Moving data macro problem	MattMurdock	Excel Programming	1	07-20-2012 04:49 AM
Another simple macro problem	Ulodesk	Word VBA	1	06-08-2012 06:24 PM