Pulling of data from sheet1 to sheet2 or any backup

[tariqnaz2005]

Hi all,

Fisrt of thanks all of you cuz whenever we got stuck you guys helped me..

I have some data in sheet1 (as per attached sheet), every month i have to enter this data more than 1000 rows..i want a formula so that automatically this data should go to sheet2 and get a seperate report shape (as mentioned in sheet2) and also add a row below of each report in case ColumnA (Shipp) data is increased for some shipp name and also report heading shoudl be change according to columnA (shipp) and renumbering it..

Please check my attached sheet and you will understand it..

Kindly do it for me..thanks

I m highly thankfull to you in advance..

[JBeaucaire]

Try this macro on your sheet. Make sure there is data in Sheet1.

MACRO REMOVED...see next post for updated code

==========
How to use the macro:

1. Open up your workbook
2. Get into VB Editor (Press Alt+F11)
3. Insert a new module (Insert > Module)
4. Copy and Paste in your code (given above)
5. Get out of VBA (Press Alt+Q)
6. Save your sheet

The macro is installed and ready to use. Press Alt-F8 and select it from the macro list.

[JBeaucaire]

I forgot about the the numbering in column B...this version fixes that:

Option Explicit

Sub CreateReport()
'JBeaucaire  (10/27/2009)
Dim BR As Long, LR As Long, NR As Long, Rng As Range, cell As Range
Application.ScreenUpdating = False

'Clear old report
    Sheets("Sheet2").Cells.Clear

'Setup
    Sheets("Sheet1").Activate
    Range("A1") = "SHIPP"
    Range("A:A").AdvancedFilter xlFilterCopy, , Range("P1"), True
    LR = Range("P" & Rows.Count).End(xlUp).Row
    Set Rng = Range("P2:P" & LR)
    BR = Range("A" & Rows.Count).End(xlUp).Row
    NR = 4
    Range("A1:M1").AutoFilter

'Create report on Sheet2
    For Each cell In Rng
        Range("A1:M1").AutoFilter Field:=1, Criteria1:=cell
        Range("A1:M" & BR).Copy Sheets("Sheet2").Range("A" & NR)
        
        With Sheets("Sheet2")
            With .Range("B" & NR - 2, "L" & NR - 2)
                .Font.Size = 12
                .Font.Bold = True
                .MergeCells = True
                .HorizontalAlignment = xlCenter
            End With
            .Range("B" & NR - 2).Value = "SIMA " & cell
            LR = .Range("A" & .Rows.Count).End(xlUp).Row + 1
            .Range("H" & LR) = "Balance"
            .Range("I" & LR).FormulaR1C1 = "=SUM(R" & NR & "C:R[-1]C)"
            .Range("I" & LR).Borders(xlEdgeBottom).LineStyle = xlDouble
            .Range("I" & LR).Borders(xlEdgeBottom).Weight = xlThick
            .Rows(LR).Font.Size = 11
            .Rows(LR).Font.Bold = True
            .Range("B" & NR + 1) = 1
            If LR - 1 - NR > 1 Then .Range("B" & NR + 2) = 2
            If LR - 1 - NR > 2 Then .Range("B" & NR + 1, "B" & NR + 2).AutoFill Destination:=.Range("B" & NR + 1, "B" & LR - 1)
            .Rows(NR + 1).Insert xlShiftDown
            NR = .Range("A" & .Rows.Count).End(xlUp).Row + 5
        End With
    Next cell

'Cleanup
    ActiveSheet.AutoFilterMode = False
    Columns("P:P").ClearContents
    Sheets("Sheet2").Activate
    Application.ScreenUpdating = True
End Sub

[tariqnaz2005]

Ohhhhhh my god..i dont believe..it could happend..

You are genius GBeaucaire...I dont know how i thank to you..

Thank you very much..you did exactly what i needed..

Because of you in my office every one is appreciating me..thanks again..God Bless you..