Not working correctly... to move data...

[menor59]

Sub DataBaseQuote()
    Call Select_Last
    Dim i As Integer
    Dim ws As Worksheet
    Dim sh As Worksheet
    Dim lr As Integer
    Dim ar As Variant


    Set sh = Sheet14
    For Each ws In ThisWorkbook.Worksheets
        If ws.Range("R6") = False Then
            If Left(ws.Name, 5) = "Quote" Then
                ws.Range("D6:D62").AutoFilter 1, ">0"
                lr = ws.Range("C" & Rows.Count).End(xlUp).Row
                If lr >= 7 Then
                Range("A7:F62").Select
                Selection.Copy
            Range("AA7").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            Range("AE7:AF62").Select
            Selection.NumberFormat = "$#,##0.00"
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
            Range("A1").Select
                    Sheet14.Range("A65536").End(xlUp)(2).Value = ws.Name
                    ws.Range("AA7:AF62").Copy Sheet14.Range("C65536").End(xlUp)(2)
                    sh.Range(sh.Cells(sh.Cells(Rows.Count, 1).End(xlUp).Row, 1), _
                    sh.Cells(sh.Cells(Rows.Count, 3).End(xlUp).Row, 1)).Value = ws.Name
                End If
                ws.AutoFilterMode = False
            End If
        End If
        ws.UsedRange.Calculate
      Next ws
Application.Goto "startCell"
Application.ScreenUpdating = True
Application.Run "ProtectAll"
End Sub

I dont know what im doing wrong...It works perfectly as long as the Previous ranges are populated.

But lets say i skip the first 5 cells keeping them empty..and Start the Data entry on A5 B5 C5 D5 etc etc...it isnt putting the data over on the DataQuote sheet...Also AC7:AC62 should Resize correctly but thats not working also...Thoughts?

 

[menor59]

This should work Automatically regardless where i start as along as theres Data in D7:D62 from the Respective Row. so if i was to start on say A60 and fill out from left to right and theres a number value on D60 it should do its thing. It isnt.

 

[Garry2Rs]

I cleaned up your code some so I could look at it closer to get an idea of what you're trying to do. What's not clear to me is what sheet is active and what sheet the code should run against. IOW, what's the purposed for looping the worksheets? If you explain clearly what the intent of the code 'should be' then it will be easier to help you get closer to a working solution...

Sub DataBaseQuote()
    Call Select_Last
'    Dim i As Long, lr As Long, ar As Variant
'    Dim ws As Worksheet, sh As Worksheet
    Dim i&, lr&, ar, ws, sh '//optional syntax!

    Set sh = Sheet14
    For Each ws In ThisWorkbook.Worksheets
            If ws.Range("R6") = False Then
                If Left(ws.Name, 5) = "Quote" Then
                    ws.Range("D6:D62").AutoFilter 1, ">0"
                    lr = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
                    If lr >= 7 Then
                        With Range("A7:F62")
                            Range("AA7").Resize(.Rows.Count, .Columns.Count) = Range("A7:F62")
                        End With 'Range("A7:F62")

                        With Range("AE7:AF62")
                            .NumberFormat = "$#,##0.00": .HorizontalAlignment = xlCenter: .VerticalAlignment = xlBottom
                            .WrapText = False: .ShrinkToFit = False: .MergeCells = False: .Orientation = 0
                            .AddIndent = False: .IndentLevel = 0: .ReadingOrder = xlContext
                        End With 'Range("AE7:AF62")

                        Range("A1").Select
                        sh.Cells(sh.Rows.Count, "A").End(xlUp)(2).Value = ws.Name
                        ws.Range("AA7:AF62").Copy sh.Cells(sh.Rows.Count, "C").End(xlUp)(2)
                        sh.Cells(sh.Rows.Count, 1).End(xlUp).Resize(1, 3).Value = ws.Name
                        
                    End If 'lr >= 7
                    ws.AutoFilterMode = False
                    
                End If 'Left(ws.Name, 5) = "Quote"
                
            End If 'ws.Range("R6") = False
        ws.UsedRange.Calculate
    Next ws
    With Application
        .Goto "startCell": .ScreenUpdating = True: .Run "ProtectAll"
    End With
End Sub

 

[menor59]

I cleaned up your code some so I could look at it closer to get an idea of what you're trying to do. What's not clear to me is what sheet is active and what sheet the code should run against. IOW, what's the purposed for looping the worksheets? If you explain clearly what the intent of the code 'should be' then it will be easier to help you get closer to a working solution...

Sub DataBaseQuote()
    Call Select_Last
'    Dim i As Long, lr As Long, ar As Variant
'    Dim ws As Worksheet, sh As Worksheet
    Dim i&, lr&, ar, ws, sh '//optional syntax!

    Set sh = Sheet14
    For Each ws In ThisWorkbook.Worksheets
            If ws.Range("R6") = False Then
                If Left(ws.Name, 5) = "Quote" Then
                    ws.Range("D6:D62").AutoFilter 1, ">0"
                    lr = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
                    If lr >= 7 Then
                        With Range("A7:F62")
                            Range("AA7").Resize(.Rows.Count, .Columns.Count) = Range("A7:F62")
                        End With 'Range("A7:F62")

                        With Range("AE7:AF62")
                            .NumberFormat = "$#,##0.00": .HorizontalAlignment = xlCenter: .VerticalAlignment = xlBottom
                            .WrapText = False: .ShrinkToFit = False: .MergeCells = False: .Orientation = 0
                            .AddIndent = False: .IndentLevel = 0: .ReadingOrder = xlContext
                        End With 'Range("AE7:AF62")

                        Range("A1").Select
                        sh.Cells(sh.Rows.Count, "A").End(xlUp)(2).Value = ws.Name
                        ws.Range("AA7:AF62").Copy sh.Cells(sh.Rows.Count, "C").End(xlUp)(2)
                        sh.Cells(sh.Rows.Count, 1).End(xlUp).Resize(1, 3).Value = ws.Name
                        
                    End If 'lr >= 7
                    ws.AutoFilterMode = False
                    
                End If 'Left(ws.Name, 5) = "Quote"
                
            End If 'ws.Range("R6") = False
        ws.UsedRange.Calculate
    Next ws
    With Application
        .Goto "startCell": .ScreenUpdating = True: .Run "ProtectAll"
    End With
End Sub

Please Forgive me. It is a rather big thing. and i didnt know how to formulate the question...

heres the Work book...VBA is Unlocked..

https://docs.google.com/file/d/0B1BS5RUbGx58S0VaQ2JoR19qcVE/edit?usp=sharing

Maybe a visual can help