• 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.

Code working for one sheet out of 6. So confused

Ashe77

Ashe77

New Member
Hi. I have a WIP document that a friend who is far better at VBA than I made for me and it's designed so that at the click of a button on an overview page,it goes into 6 sheets, looks in 6 sheets for a status type, copies where appropriate and pastes into a summary sheet (for example, all "Open" tasks).

It seems to be working for one sheet, the first one but not for the others despite the code being the same. I have checked the references to the check boxes on the overview page and cell references and they all match up. For reference, the sheets are called "Esso Let", "Tesco Dev", "Tesco Tablet", "Tesco Hand Scanners", "Spare 3" and ""Spare 4" and the summary sheets are "In Progress" and "Open Issues"

Code: 
If ActiveSheet.Shapes("Check Box 16").ControlFormat.Value = 1 Then
    CopySheet = Range("F4").Value
    SheetHeader = "Esso Let"
    Sheets(CopySheet).Select
    Call PasteFunctionInfo(CopySheet, SheetHeader)
    Sheets(CopySheet).Select
    Call PasteFunctionAction(CopySheet, SheetHeader)
    End If
Sheets("Overview").Select

If ActiveSheet.Shapes("Check Box 17").ControlFormat.Value = 1 Then
    CopySheet = Range("F14").Value
    SheetHeader = "Tesco Dev"
    Sheets(CopySheet).Select
    Call PasteFunctionInfo(CopySheet, SheetHeader)
    Sheets(CopySheet).Select
    Call PasteFunctionAction(CopySheet, SheetHeader)
    End If
Sheets("Overview").Select

If ActiveSheet.Shapes("Check Box 21").ControlFormat.Value = 1 Then
    CopySheet = Range("F24").Value
    SheetHeader = "Tesco Tablet"
    Sheets(CopySheet).Select
    Call PasteFunctionInfo(CopySheet, SheetHeader)
    Sheets(CopySheet).Select
    Call PasteFunctionAction(CopySheet, SheetHeader)
    End If
Sheets("Overview").Select

If ActiveSheet.Shapes("Check Box 22").ControlFormat.Value = 1 Then
    CopySheet = Range("F34").Value
    SheetHeader = "Tesco Hand Scanners"
    Sheets(CopySheet).Select
    Call PasteFunctionInfo(CopySheet, SheetHeader)
    Sheets(CopySheet).Select
    Call PasteFunctionAction(CopySheet, SheetHeader)
    End If
Sheets("Overview").Select

If ActiveSheet.Shapes("Check Box 23").ControlFormat.Value = 1 Then
    CopySheet = Range("F44").Value
    SheetHeader = "Spare 3"
    Sheets(CopySheet).Select
    Call PasteFunctionInfo(CopySheet, SheetHeader)
    Sheets(CopySheet).Select
    Call PasteFunctionAction(CopySheet, SheetHeader)
    End If
Sheets("Overview").Select

If ActiveSheet.Shapes("Check Box 29").ControlFormat.Value = 1 Then
    CopySheet = Range("F54").Value
    SheetHeader = "Spare 4"
    Sheets(CopySheet).Select
    Call PasteFunctionInfo(CopySheet, SheetHeader)
    Sheets(CopySheet).Select
    Call PasteFunctionAction(CopySheet, SheetHeader)
    End If
Sheets("Overview").Select

End1:
 
Hi Ashe, and welcome to the forum! :awesome:

It looks like part of your code that you posted is missing, as it doesn't have the Sub Name or End Sub. But, at a basic glace, it looks like everything is done on the ActiveSheet, but the Overview sheet is the only one selected. Can you post the complete macro, and then we might be able to suggest an edit? W/o knowing the full scope of macro, I don't want to change something that may be important later.
 
Sure thing, all is below. The bits at the very bottom in quotation marks for popups are a bit of fun he put in to keep me sane.
Code: 
Public Sub CoreVBA()
Dim CopySheet As String
Dim SheetHeader As String

'"If ActiveSheet.Shapes("Check Box 16").ControlFormat.Value = 1" Checks to see if the tick box (Check Box 16) is ticked or not
'"[Variable] = [Value]" - Sets the variable prepared above when we used the "Dim" command.
'"Sheets([Variable]).Select" - As you can see, we can use variables without quotation marks whenever a range or direct link is necessary.
'"Call [Sub]([Variable1, Variable2)" - When calling a sub, you can also declare variables. This allows the variables to pass over between subs.
If ActiveSheet.Shapes("Check Box 16").ControlFormat.Value = 1 Then
    CopySheet = Range("F4").Value
    SheetHeader = "Esso Let"
    Sheets(CopySheet).Select
    Call PasteFunctionInfo(CopySheet, SheetHeader)
    Sheets(CopySheet).Select
    Call PasteFunctionAction(CopySheet, SheetHeader)
    End If
Sheets("Overview").Select

If ActiveSheet.Shapes("Check Box 17").ControlFormat.Value = 1 Then
    CopySheet = Range("F14").Value
    SheetHeader = "Tesco Dev"
    Sheets(CopySheet).Select
    Call PasteFunctionInfo(CopySheet, SheetHeader)
    Sheets(CopySheet).Select
    Call PasteFunctionAction(CopySheet, SheetHeader)
    End If
Sheets("Overview").Select

If ActiveSheet.Shapes("Check Box 21").ControlFormat.Value = 1 Then
    CopySheet = Range("F24").Value
    SheetHeader = "Tesco Tablet"
    Sheets(CopySheet).Select
    Call PasteFunctionInfo(CopySheet, SheetHeader)
    Sheets(CopySheet).Select
    Call PasteFunctionAction(CopySheet, SheetHeader)
    End If
Sheets("Overview").Select

If ActiveSheet.Shapes("Check Box 22").ControlFormat.Value = 1 Then
    CopySheet = Range("F34").Value
    SheetHeader = "Tesco Hand Scanners"
    Sheets(CopySheet).Select
    Call PasteFunctionInfo(CopySheet, SheetHeader)
    Sheets(CopySheet).Select
    Call PasteFunctionAction(CopySheet, SheetHeader)
    End If
Sheets("Overview").Select

If ActiveSheet.Shapes("Check Box 23").ControlFormat.Value = 1 Then
    CopySheet = Range("F44").Value
    SheetHeader = "Spare 3"
    Sheets(CopySheet).Select
    Call PasteFunctionInfo(CopySheet, SheetHeader)
    Sheets(CopySheet).Select
    Call PasteFunctionAction(CopySheet, SheetHeader)
    End If
Sheets("Overview").Select

If ActiveSheet.Shapes("Check Box 29").ControlFormat.Value = 1 Then
    CopySheet = Range("F54").Value
    SheetHeader = "Spare 4"
    Sheets(CopySheet).Select
    Call PasteFunctionInfo(CopySheet, SheetHeader)
    Sheets(CopySheet).Select
    Call PasteFunctionAction(CopySheet, SheetHeader)
    End If
Sheets("Overview").Select

End1:
Sheets("Overview").Select
''If ActiveSheet.Shapes("Option Button 12").ControlFormat.Value = xlOn Then
''NOTHING SELECTED
''    MsgBox "Nothing selected"

''    GoTo End2
''        Else
''            If ActiveSheet.Shapes("Option Button 13").ControlFormat.Value = xlOn Then
''EXPORT SELECTED
''                MsgBox "Export selected"
''                GoTo End2
''                    Else
''                        If ActiveSheet.Shapes("Option Button 14").ControlFormat.Value = xlOn Then
''EXPORT & EMAIL SELECTED
''                            MsgBox "Export & Email Selected"
''                            GoTo End2
''                                Else
''                                    GoTo End2
''                        End If
''            End If
''End If
Sheets("In Progress").Select
    With ActiveSheet
            .AutoFilterMode = False
    End With
Sheets("Open Issues").Select
    With ActiveSheet
            .AutoFilterMode = False
    End With
End2:
Sheets("Overview").Select
Randomize
random_number = Int(20 * Rnd) + 1
Select Case random_number
    Case 1
        MsgBox "Hodor!!!", vbExclamation
    Case 2
        MsgBox "Which seat can I take?"
    Case 3
        MsgBox "So many activities"
    Case 4
        MsgBox "''What are you gonna do? Stab me?''" & Chr(10) & Chr(10) & "Quote from man stabbed"
    Case 5
        MsgBox "Never gonna give you up" & Chr(10) & "Never gonna let you down" & Chr(10) & "Never gonna run around and desert you." & Chr(10) & Chr(10) & "Never gonna make you cry" & Chr(10) & "Never gonna say goodbye" & Chr(10) & "Never gonna tell a lie and hurt you."
    Case 6
        Dim myForm As Image1
        Set myForm = New Image1
        myForm.Caption = "SUCH IMAGE. VERY VBA."
        myForm.Show
Lbl_Exit:
    End Select
End Sub
 
Thanks. Ok, so breaking it down so I can understand, it looks like this block fo code gets repeated 6 times (with some names changing)
Code: 
    If ActiveSheet.Shapes("Check Box 16").ControlFormat.Value = 1 Then
        CopySheet = Range("F4").Value
        SheetHeader = "Esso Let"
        Sheets(CopySheet).Select
        Call PasteFunctionInfo(CopySheet, SheetHeader)
        Sheets(CopySheet).Select
        Call PasteFunctionAction(CopySheet, SheetHeader)
    End If
    Sheets("Overview").Select

Since the Overview sheet is the one being selected, I'm assuming it's the ActiveSheet at start of code. So, code should be checking different check boxes on the Overview sheet. If it's checked, it's going to do something with a sheet whose name is in col F, and one of the 6 sheets your specified (in this block, it's the Esso Let sheet. I don't know what the PaseFunctionInfo and PasteFunctionAction macros do; they must be somewhere else in your code.

Have you verified that the values in col F (F4, F14, F24, etc.) are what you would expect them to be?

does the code crash when it runs, or is runs but only the first sheet, Esso Let, gets changed?
 
Hi Luke

Yes, you have it spot on there in terms of what it's supposed to do. I've checked the overview sheet and the tick box names and Column F locations match as per the code. When I run it, it works and copies/pastes the Esso Let sheet's relevant results ("open" and "in progress" actions) but stops there and doesn't run the others.

upload_2016-7-13_15-3-49.png
 

Attachments

  • upload_2016-7-13_15-3-23.png
    upload_2016-7-13_15-3-23.png
    74.3 KB · Views: 1
Oh and also in case I didn't detail, it only copies entries matching "In Progress" for the Esso Let sheet to the In progress sheet, not "Open" ones to the Open summary sheet.
 
but stops there and doesn't run the others.
Click to expand...

As in, an error message appears? If yes, when you hit 'Debug', what line is highlighted?

Can you post the code for the two functions, PaseFunctionInfo and PasteFunctionAction?
 
No error message at all, just runs, finishes but seems to only copy and paste the Esso Let sheet.

Hopefully the below is the right part of the code

Code: 
Private Sub PasteFunctionInfo(CopySheet As String, SheetHeader As String)
On Error GoTo End2
    With ActiveSheet
        .AutoFilterMode = False
            With .Range("A21:M21")
                .AutoFilter Field:=1, Criteria1:="In Progress*"
            End With
    End With
Range("B21", Range("B65536").End(xlUp)).Select
Selection.Offset(1).Resize(Selection.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
    Sheets("In Progress").Select
    Cells(2, 1).Value = SheetHeader
    Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
    Selection.Offset(0, -1) = SheetHeader
Sheets(CopySheet).Select
Range("D21", Range("D65536").End(xlUp)).Select
Selection.Offset(1).Resize(Selection.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
    Sheets("In Progress").Select
    Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
Sheets(CopySheet).Select
Range("G21", Range("G65536").End(xlUp)).Select
Selection.Offset(1).Resize(Selection.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
    Sheets("In Progress").Select
    Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
Sheets(CopySheet).Select
Range("H21", Range("H65536").End(xlUp)).Select
Selection.Offset(1).Resize(Selection.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
    Sheets("In Progress").Select
    Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
Sheets(CopySheet).Select
Range("A21", Range("A65536").End(xlUp)).Select
Selection.Offset(1).Resize(Selection.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
    Sheets("In Progress").Select
    Cells(Rows.Count, 6).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
End2:
End Sub
Private Sub PasteFunctionAction(CopySheet As String, SheetHeader As String)
On Error GoTo End3
    With ActiveSheet
        .AutoFilterMode = False
            With .Range("A21:M21")
                .AutoFilter Field:=1, Criteria1:="Open*"
            End With
    End With
Range("B21", Range("B65536").End(xlUp)).Select
Selection.Offset(1).Resize(Selection.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
    Sheets("Open Issues").Select
    Cells(2, 1).Value = SheetHeader
    Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
    Selection.Offset(0, -1) = SheetHeader
Sheets(CopySheet).Select
Range("C21", Range("J65536").End(xlUp)).Select
Selection.Offset(1).Resize(Selection.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
    Sheets("Open Issues").Select
    Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
               
           
End3:
End Sub

Private Sub ExportSummaryFunction()
Workbooks.Open ("G:\Paul Dew\Rollout Master Spreadsheet\BlankSummary.xlsx")
Windows("RolloutMaster.xlsm").Activate
    Sheets("In Progress").Select
    Range("A5", Range("F65536").End(xlUp)).Select
        Selection.Offset(1).Resize(Selection.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
    Windows("BlankSummary.xlsx").Activate
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.DisplayAlerts = False
    Dim FilePath As String
    Dim NewName As String
    FilePath = "G:\Paul Dew\Rollout Master Spreadsheet\Archive\" & Year(Date) & "\" & MonthName(Month(Date), False) & "\": NewName = FilePath & Format(Date, "DDMMYYYY") & "-Rollout Tracker-Summary" & ".xlsx"
    ActiveWorkbook.SaveAs Filename:=NewName, FileFormat _
    :=xlOpenXMLWorkbook, CreateBackup:=False
    Application.DisplayAlerts = True
    ActiveWorkbook.Close
End Sub
Private Sub ExportOpenFunction()
Workbooks.Open ("G:\Paul Dew\Rollout Master Spreadsheet\BlankOpenIssues.xlsx")
Windows("RolloutMaster.xlsm").Activate
    Sheets("Open Issues").Select
    Range("A5", Range("J65536").End(xlUp)).Select
        Selection.Offset(1).Resize(Selection.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
    Windows("BlankOpenIssues.xlsx").Activate
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.DisplayAlerts = False
    Dim FilePath As String
    Dim NewName As String
    FilePath = "G:\Paul Dew\Rollout Master Spreadsheet\Archive\" & Year(Date) & "\" & MonthName(Month(Date), False) & "\": NewName = FilePath & Format(Date, "DDMMYYYY") & "-Rollout Tracker-Open Issues" & ".xlsx"
    ActiveWorkbook.SaveAs Filename:=NewName, FileFormat _
    :=xlOpenXMLWorkbook, CreateBackup:=False
    Application.DisplayAlerts = True
    ActiveWorkbook.Close
End Sub
 
Strange. The code never actually goes to the worksheet named SheetHeader (your 6 different sheets). Is it supposed to?
 
It is yeah. The main aim is to look at all 6 sheets, pick any lines where column A's entry says Open or In Progress, copy it and paste into the respective summary sheet.
 
Luke

Would it be of any use if I sent you the workbook itself? May be quicker and more beneficial for you.

Paul
 
If it helps, when I step into the code,

Public Sub CoreVBA()

is highlighted yellow. The whole string is below again before breaking and other button functions in the sheet.

Code: 
Public Sub CoreVBA()
Dim CopySheet As String
Dim SheetHeader As String

'"If ActiveSheet.Shapes("Check Box 16").ControlFormat.Value = 1" Checks to see if the tick box (Check Box 16) is ticked or not
'"[Variable] = [Value]" - Sets the variable prepared above when we used the "Dim" command.
'"Sheets([Variable]).Select" - As you can see, we can use variables without quotation marks whenever a range or direct link is necessary.
'"Call [Sub]([Variable1, Variable2)" - When calling a sub, you can also declare variables. This allows the variables to pass over between subs.
If ActiveSheet.Shapes("Check Box 16").ControlFormat.Value = 1 Then
    CopySheet = Range("F4").Value
    SheetHeader = "Esso Let"
    Sheets(CopySheet).Select
    Call PasteFunctionInfo(CopySheet, SheetHeader)
    Sheets(CopySheet).Select
    Call PasteFunctionAction(CopySheet, SheetHeader)
    End If
Sheets("Overview").Select

If ActiveSheet.Shapes("Check Box 17").ControlFormat.Value = 1 Then
    CopySheet = Range("F14").Value
    SheetHeader = "Tesco Dev"
    Sheets(CopySheet).Select
    Call PasteFunctionInfo(CopySheet, SheetHeader)
    Sheets(CopySheet).Select
    Call PasteFunctionAction(CopySheet, SheetHeader)
    End If
Sheets("Overview").Select

If ActiveSheet.Shapes("Check Box 21").ControlFormat.Value = 1 Then
    CopySheet = Range("F24").Value
    SheetHeader = "Tesco Tablet"
    Sheets(CopySheet).Select
    Call PasteFunctionInfo(CopySheet, SheetHeader)
    Sheets(CopySheet).Select
    Call PasteFunctionAction(CopySheet, SheetHeader)
    End If
Sheets("Overview").Select

If ActiveSheet.Shapes("Check Box 22").ControlFormat.Value = 1 Then
    CopySheet = Range("F34").Value
    SheetHeader = "Tesco Hand Scanners"
    Sheets(CopySheet).Select
    Call PasteFunctionInfo(CopySheet, SheetHeader)
    Sheets(CopySheet).Select
    Call PasteFunctionAction(CopySheet, SheetHeader)
    End If
Sheets("Overview").Select

If ActiveSheet.Shapes("Check Box 23").ControlFormat.Value = 1 Then
    CopySheet = Range("F44").Value
    SheetHeader = "Spare 3"
    Sheets(CopySheet).Select
    Call PasteFunctionInfo(CopySheet, SheetHeader)
    Sheets(CopySheet).Select
    Call PasteFunctionAction(CopySheet, SheetHeader)
    End If
Sheets("Overview").Select

If ActiveSheet.Shapes("Check Box 29").ControlFormat.Value = 1 Then
    CopySheet = Range("F54").Value
    SheetHeader = "Spare 4"
    Sheets(CopySheet).Select
    Call PasteFunctionInfo(CopySheet, SheetHeader)
    Sheets(CopySheet).Select
    Call PasteFunctionAction(CopySheet, SheetHeader)
    End If
Sheets("Overview").Select

End1:
Sheets("Overview").Select
''If ActiveSheet.Shapes("Option Button 12").ControlFormat.Value = xlOn Then
''NOTHING SELECTED
''    MsgBox "Nothing selected"

''    GoTo End2
''        Else
''            If ActiveSheet.Shapes("Option Button 13").ControlFormat.Value = xlOn Then
''EXPORT SELECTED
''                MsgBox "Export selected"
''                GoTo End2
''                    Else
''                        If ActiveSheet.Shapes("Option Button 14").ControlFormat.Value = xlOn Then
''EXPORT & EMAIL SELECTED
''                            MsgBox "Export & Email Selected"
''                            GoTo End2
''                                Else
''                                    GoTo End2
''                        End If
''            End If
''End If
Sheets("In Progress").Select
    With ActiveSheet
            .AutoFilterMode = False
    End With
Sheets("Open Issues").Select
    With ActiveSheet
            .AutoFilterMode = False
    End With
End2:
Sheets("Overview").Select
Randomize
random_number = Int(10 * Rnd) + 1
Select Case random_number
    Case 1
        MsgBox "What do I do with my feet?"
    Case 2
        MsgBox "Shake n Bake"
    Case 3
        MsgBox "So many activities"
    Case 4
        MsgBox "''What are you gonna do? Stab me?''" & Chr(10) & Chr(10) & "Quote from man stabbed"
    Case 5
        MsgBox "Never gonna give you up" & Chr(10) & "Never gonna let you down" & Chr(10) & "Never gonna run around and desert you." & Chr(10) & Chr(10) & "Never gonna make you cry" & Chr(10) & "Never gonna say goodbye" & Chr(10) & "Never gonna tell a lie and hurt you."
    Case 6
        Dim myForm As Image1
        Set myForm = New Image1
        myForm.Caption = "SUCH IMAGE. VERY VBA."
        myForm.Show
Lbl_Exit:
    End Select
End Sub
Private Sub PasteFunctionInfo(CopySheet As String, SheetHeader As String)
On Error GoTo End2
    With ActiveSheet
        .AutoFilterMode = False
            With .Range("A21:M21")
                .AutoFilter Field:=1, Criteria1:="In Progress*"
            End With
    End With
Range("B21", Range("B65536").End(xlUp)).Select
Selection.Offset(1).Resize(Selection.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
    Sheets("In Progress").Select
    Cells(2, 1).Value = SheetHeader
    Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
    Selection.Offset(0, -1) = SheetHeader
Sheets(CopySheet).Select
Range("D21", Range("D65536").End(xlUp)).Select
Selection.Offset(1).Resize(Selection.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
    Sheets("In Progress").Select
    Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
Sheets(CopySheet).Select
Range("G21", Range("G65536").End(xlUp)).Select
Selection.Offset(1).Resize(Selection.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
    Sheets("In Progress").Select
    Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
Sheets(CopySheet).Select
Range("H21", Range("H65536").End(xlUp)).Select
Selection.Offset(1).Resize(Selection.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
    Sheets("In Progress").Select
    Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
Sheets(CopySheet).Select
Range("A21", Range("A65536").End(xlUp)).Select
Selection.Offset(1).Resize(Selection.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
    Sheets("In Progress").Select
    Cells(Rows.Count, 6).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
End2:
End Sub
 
Paul,

Yes, if you could post the workbook, that'd be a big help. I think I'm close to understanding the layout, but it's still a little fuzzy. What I've got so far:

You've got 6 different sheets with data. You want to pull data from each of these sheets where col A says either "Open" or "In Progress" and put them in one of two sheets (to hold either all the 'Open' or 'In Progress' items).

That about sum it up?
 
Great, I'll try to take a look at it tonight. Can't access shared storage locations from my current location. :(
 
Ugh, I'm sorry Paul. I got caught up in another project and completely forgot. I really have no excuse. :(

I'll try again tonight/over the weekend. Thanks for your understanding.
 
Hi Luke

No no not at all, it's fine. You have your own stuff to do! Whenever is ok for you, hopefully (and likely) it's an easy fix.

Paul
 
Paul,

No need to feel sorry, I'm the one who was late. :p
I'm looking at it right now actually, will post back later. :)
 
Hi Luke

Actually managed to fix it! A work colleague had a look and cracked it. Something stupid on my part too, the other sheets had the leading row with Status etc was on the wrong row so threw the reference out.

Thank you for looking anyway though.

Paul
 
Well, that's good to hear. If it gets to be an issue again, the code could be made much more robust by using the Tables (ListObjects), rather than hard coding all the range addresses. But it's good 'nuff for now! :)
 
You must log in or register to reply here.
Back
Top