macro consolidates data from worksheets - question

**jw01** · 03-29-2012, 05:22 PM

hi

i have the following code:

Private Sub Worksheet_Activate()
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim LR As Long, NR As Long

Application.ScreenUpdating = False

Set Newsh = ThisWorkbook.Sheets(Sheet20.Name)
Newsh.Range("C12").CurrentRegion.Offset(1).Clear
NR = 9

    
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.Name Like "*" And Sh.Name <> Sheet7.Name And Sh.Name <> Sheet1.Name And Sh.Name <> Sheet19.Name And Sh.Name <> Sheet18.Name And Sh.Name <> Sheet17.Name And Sh.Name <> Sheet16.Name And Sh.Name <> Sheet15.Name And Sh.Name <> Sheet14.Name And Sh.Name <> Sheet13.Name And Sh.Name <> Sheet12.Name And Sh.Name <> Sheet11.Name And Sh.Name <> Sheet10.Name And Sh.Name <> Sheet19.Name And Sh.Name <> Sheet20.Name And Sh.Name <> Sheet20.Name And Sh.Visible Then
            LR = Sh.Range("B" & Sh.Rows.Count).End(xlUp).Row
            If LR > 8 Then
                Sh.Range("C13:AJ" & LR).Copy
                Newsh.Range("C" & NR).PasteSpecial xlPasteFormats
                Newsh.Range("C" & NR).PasteSpecial xlPasteAll
                LR = Newsh.Range("C" & Rows.Count).End(xlUp).Row
                Newsh.Range("A" & NR, "A" & LR) = Sh.Name
                NR = LR + 1
   
            End If
        End If
    Next Sh
    
Application.ScreenUpdating = True

End Sub

the issue:
i would like for the macro to paste the data start from cell C13:AJ

it works..but its pasting the data now in row 13 of column C....can someone pls help and advise?

**DGagnon** · 03-29-2012, 05:42 PM

Where do you want the data to paste? this will paste starting at C1, you can modify the commented row as needed

Private Sub Worksheet_Activate()
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim LR As Long, NR As Long

Application.ScreenUpdating = False

Set Newsh = ThisWorkbook.Sheets(Sheet20.Name)
Newsh.Range("C12").CurrentRegion.Offset(1).Clear
NR = 9

    
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.Name Like "*" And Sh.Name <> Sheet7.Name And Sh.Name <> Sheet1.Name And Sh.Name <> Sheet19.Name And Sh.Name <> Sheet18.Name And Sh.Name <> Sheet17.Name And Sh.Name <> Sheet16.Name And Sh.Name <> Sheet15.Name And Sh.Name <> Sheet14.Name And Sh.Name <> Sheet13.Name And Sh.Name <> Sheet12.Name And Sh.Name <> Sheet11.Name And Sh.Name <> Sheet10.Name And Sh.Name <> Sheet19.Name And Sh.Name <> Sheet20.Name And Sh.Name <> Sheet20.Name And Sh.Visible Then
            LR = Sh.Range("B" & Sh.Rows.Count).End(xlUp).Row
            If LR > 8 Then
                Sh.Range("C13:AJ" & LR).Copy
                Newsh.Range("C1").PasteSpecial xlPasteFormats 'Paste Destination
                Newsh.Range("C1").PasteSpecial xlPasteAll 'Paste Destination
                LR = Newsh.Range("C" & Rows.Count).End(xlUp).Row
                Newsh.Range("A" & NR, "A" & LR) = Sh.Name
                NR = LR + 1
   
            End If
        End If
    Next Sh
    
Application.ScreenUpdating = True

End Sub

**jw01** · 03-30-2012, 01:02 AM

hey thxs for your help

i have changed the cel to b13...but for some reason it's not consolidating the data from all the unhidden worksheets? can u pls help?

*see link*..im having some issue uploading :S

https://skydrive.live.com/redir.aspx...CBc3-EgrNCjfgk

Private Sub Worksheet_Activate()
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim LR As Long, NR As Long

Application.ScreenUpdating = False

Set Newsh = ThisWorkbook.Sheets(Sheet20.Name)
Newsh.Range("C12").CurrentRegion.Offset(1).Clear
NR = 9

    
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.Name <> Sheet1.Name And Sh.Name <> Sheet7.Name And Sh.Visible Then
            LR = Sh.Range("B" & Sh.Rows.Count).End(xlUp).Row
            If LR > 8 Then
                Sh.Range("B13:AJ" & LR).Copy
                Newsh.Range("B13").PasteSpecial xlPasteValues 'Paste Destination
                Newsh.Range("B13").PasteSpecial xlPasteValues 'Paste Destination
                LR = Newsh.Range("B" & Rows.Count).End(xlUp).Row
                NR = LR + 1
   
            End If
        End If
    Next Sh
    
Application.ScreenUpdating = True

End Sub

thx u so much!

**DGagnon** · 03-30-2012, 08:11 AM

I cant view the file due to firewall, but try this

Private Sub Worksheet_Activate()
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim LR As Long, NR As Long

Application.ScreenUpdating = False

Set Newsh = ThisWorkbook.Sheets(20).Name
Newsh.Range("C12").CurrentRegion.Offset(1).Clear
NR = 9

    
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.Name <> Sheets(1).Name And Sh.Name <> Sheets(7).Name And Sh.Visible Then
            LR = Sh.Range("B" & Sh.Rows.Count).End(xlUp).Row
            If LR > 8 Then
                Sh.Range("B13:AJ" & LR).Copy
                Newsh.Range("B13").PasteSpecial xlPasteValues 'Paste Destination
                Newsh.Range("B13").PasteSpecial xlPasteValues 'Paste Destination
                LR = Newsh.Range("B" & Rows.Count).End(xlUp).Row
                NR = LR + 1
   
            End If
        End If
    Next Sh
    
Application.ScreenUpdating = True

End Sub

**jw01** · 03-30-2012, 09:46 AM

hey im getting an error "object required" on this line

Set Newsh = ThisWorkbook.Sheets(20).Name

ur thoughts?

**DGagnon** · 03-30-2012, 09:55 AM

the newsh is the sheet object so it does not require the .name paramater

try this

Sub test()
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim LR As Long, NR As Long

Application.ScreenUpdating = False

Set Newsh = ThisWorkbook.Sheets(20)
Newsh.Range("C12").CurrentRegion.Offset(1).Clear
NR = 9

    
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.Name <> Sheets(1).Name And Sh.Name <> Sheets(7).Name And Sh.Visible Then
            LR = Sh.Range("B" & Sh.Rows.Count).End(xlUp).Row
            If LR > 8 Then
                Sh.Range("B13:AJ" & LR).Copy
                Newsh.Range("B13").PasteSpecial xlPasteValues 'Paste Destination
                Newsh.Range("B13").PasteSpecial xlPasteValues 'Paste Destination
                LR = Newsh.Range("B" & Rows.Count).End(xlUp).Row
                NR = LR + 1
   
            End If
        End If
    Next Sh
    
Application.ScreenUpdating = True

End Sub

**jw01** · 03-30-2012, 10:02 AM

actually its notwrking at all now....when i paste the new code :S

**DGagnon** · 03-30-2012, 10:48 AM

could you include a sheet with sample data? i cannot access skydrive.

**jw01** · 03-30-2012, 11:17 AM

it's not uploading the file on this thread for some wierd reason :S

i uploadd it onto google docs...u dont need to sign in...let me know if this works.

https://docs.google.com/open?id=0B1Q...Rm5BRGVadUtadw

thxs!

**DGagnon** · 03-30-2012, 03:13 PM

took a look and made a couple change, give this a run

Private Sub Worksheet_Activate()
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim LR As Long, NR As Long

Application.ScreenUpdating = False

Set Newsh = ThisWorkbook.Sheets(Sheet20.Name)
Newsh.Range("C12").CurrentRegion.Offset(1).Clear
NR = 13

    
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.Name <> Sheet1.Name And Sh.Name <> Sheet7.Name And Sh.Name <> Sheet20.Name And Sh.Visible Then
            LR = Sh.Range("B" & Sh.Rows.Count).End(xlUp).Row
            If LR > 8 Then
                Sh.Range("C13:AJ" & LR).Copy
                Newsh.Range("C" & NR).PasteSpecial xlPasteFormats 'Paste Destination
                Newsh.Range("C" & NR).PasteSpecial xlPasteAll 'Paste Destination
                NR = Newsh.Range("C" & Rows.Count).End(xlUp).Row + 1
   
            End If
        End If
    Next Sh
    
Application.ScreenUpdating = True

End Sub

**jw01** · 03-30-2012, 03:49 PM

omg thxu so much for your great help....i was confused...it appears this was the missing link "And Sh.Name <> Sheet20.Name"

also...real quick...i have a formula in column B on the consolidation sheet
if(C1="",0,1)
where if 1...then i have a conditional format for the row to have a border ...else if 0 then no border....

that part is not coming through...any idea why? thx u sir

**DGagnon** · 03-30-2012, 04:27 PM

this should take care of that

Private Sub Worksheet_Activate()
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim LR As Long, NR As Long

Application.ScreenUpdating = False

Set Newsh = ThisWorkbook.Sheets(Sheet20.Name)
Newsh.Range("C12").CurrentRegion.Offset(1).Clear
NR = 13

    
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.Name <> Sheet1.Name And Sh.Name <> Sheet7.Name And Sh.Name <> Sheet20.Name And Sh.Visible Then
            LR = Sh.Range("B" & Sh.Rows.Count).End(xlUp).Row
            If LR > 8 Then
                Sh.Range("C13:AJ" & LR).Copy
                Newsh.Range("C" & NR).PasteSpecial xlPasteFormats 'Paste Destination
                Newsh.Range("C" & NR).PasteSpecial xlPasteAll 'Paste Destination
                NR = Newsh.Range("C" & Rows.Count).End(xlUp).Row + 1
            End If
        End If
    Next Sh
    Newsh.Range("B1:B" & NR - 1).FormulaR1C1 = "=IF(RC[1]="""",0,1)"
    
Application.ScreenUpdating = True

End Sub

**jw01** · 03-30-2012, 05:09 PM

hello that works like a charm....thx u so much..it is much appreciated.

once final request..or rather an issue that is showing...for some odd reason on my consoidation sheet, all the data is beng transfered but when the macro consolidates the data from the other workbooks, it is removing the "header fields" and all other text above row 13 on the "2012" consolidation sheet....any thoughts why?

thx u once again for ur allstar help.

**DGagnon** · 03-30-2012, 06:36 PM

The macro was clearing it, i changed the clear portion to only clear the bottom of the file, not the headers

Private Sub Worksheet_Activate()
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim LR As Long, NR As Long

Application.ScreenUpdating = False

Set Newsh = ThisWorkbook.Sheets(Sheet20.Name)
Newsh.Range("C13:AP100000").Clear
NR = 13

    
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.Name <> Sheet1.Name And Sh.Name <> Sheet7.Name And Sh.Name <> Sheet20.Name And Sh.Visible Then
            LR = Sh.Range("B" & Sh.Rows.Count).End(xlUp).Row
            If LR > 8 Then
                Sh.Range("C13:AJ" & LR).Copy
                Newsh.Range("C" & NR).PasteSpecial xlPasteFormats 'Paste Destination
                Newsh.Range("C" & NR).PasteSpecial xlPasteAll 'Paste Destination
                NR = Newsh.Range("C" & Rows.Count).End(xlUp).Row + 1
            End If
        End If
    Next Sh
    Newsh.Range("B1:B" & NR - 1).FormulaR1C1 = "=IF(RC[1]="""",0,1)"
    
Application.ScreenUpdating = True

End Sub

**jw01** · 03-31-2012, 02:48 PM

hello

thxs for your wonderful help..i really appreciate all your feedback...it works like a charm now.

one query....i have the following macro filters ...however in my consolidation sheet, it does not filter by my criteria in cell C7 or named range "link"

any idea why it is not sorting?

Sub Filter_name()
    Dim c As Long
    
        Application.ScreenUpdating = False
    
    With Range("_Data").CurrentRegion
        .AutoFilter
        For c = 1 To .Columns.Count
            .AutoFilter Field:=c, VisibleDropDown:=False
        Next c
        .AutoFilter Field:=3, Criteria1:=Range("Link").Value, VisibleDropDown:=False
    End With
    
        Application.ScreenUpdating = False
    
    Range("Header") = "Filtered by: NAE Name"
    
End Sub

i truely appreciate your help sir.

**DGagnon** · 03-31-2012, 05:26 PM

you might need to open a new thread on this one, i dont know if ill be able to help with it till monday.

**jw01** · 04-02-2012, 09:36 AM

hello DGagnon,

thank you for your helpand update. please let me know if you know what the issue maybe with the filter

thx u sir!

**jw01** · 04-02-2012, 05:12 PM

hey dgagnon

any thoughts you have on this? thx u sir

**DGagnon** · 04-02-2012, 06:20 PM

sorry i dont have much experiance with Filter via VBA, might be best to start a new topic and get one of the experts in on it.

macro consolidates data from worksheets - question

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

macro consolidates data from worksheets - question

Re: macro consolidates data from worksheets - question

Re: macro consolidates data from worksheets - question

Re: macro consolidates data from worksheets - question

Re: macro consolidates data from worksheets - question

Re: macro consolidates data from worksheets - question

Re: macro consolidates data from worksheets - question

Re: macro consolidates data from worksheets - question

Re: macro consolidates data from worksheets - question

Re: macro consolidates data from worksheets - question

Re: macro consolidates data from worksheets - question

Re: macro consolidates data from worksheets - question

Re: macro consolidates data from worksheets - question

Re: macro consolidates data from worksheets - question

Re: macro consolidates data from worksheets - question

Re: macro consolidates data from worksheets - question

Re: macro consolidates data from worksheets - question

Re: macro consolidates data from worksheets - question

Re: macro consolidates data from worksheets - question

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions