Macro to dynamically select and copy data from different sheets and columns

I am just beginning working with macros and hope someone can help me meet deadline.

I am working with large file (170K records). I can’t get data in required format using pivot so I’m drilling down from pivot summary to detail.

- Pivot Sheet: Acct1 Acct2 Acct#
12 49 27


- Clicking on pivot count gives detail in 3 columns:
Acct1 DNum1 XNum1
Acct1 DNum2 XNum2
Acct1 DNum3 XNum3

… etc., where DNum and XNum can vary from 1 – 34

- I need to transpose DNum and XNum to columns per Acct on a Summary sheet i.e.:

Acct1 DNum1 XNum1 DNum2 XNum2 DNum3 XNum3 …. up to 34
Acct2 DNum1 XNum1 DNum2 XNum2 DNum3 XNum3 …. up to 34 etc.

- My original code (Macro 1) below gave me trouble moving from sheet to sheet and my code kept copying the same record. I guess I should use offset or something but just unsure how to put it together.

- I am currently using a shorter code (Macro 2 below to at least help with the copy and transpose task but I have to already be on the correct sheet but with 170K records I’ll be here all year.

Desperate for any help!

Original Code (Macro 1)


Range("AH6").Select
    Selection.ShowDetail = True
    Sheets("Sheet6").Select
    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("Table6[[DGNS_CD]:[CLM_POA_IND]]").Select
    Selection.Copy
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range("A2:P3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Main").Select
    Sheets("Main").Name = "Main"
    Range("A61").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=2
    Range("A63").Select
    Sheets("Pivot").Select
    Sheets("Pivot").Name = "Pivot"
    Range("AH7").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "D"
    Range("AH7").Select
    ActiveCell.FormulaR1C1 = "D"
    Range("AH8").Select


Modified code (Macro 2) … (may have extra unnecessary steps here ... sorry)

Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 2
    ActiveWindow.ScrollRow = 1
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range("A2:AP3").Select
    Application.CutCopyMode = False
    Selection.Copy

Moderator's Note: Don't forget your code tags. Highlight the codes the hit the "#" symbol. I'll do it for you now. Hope your issue be resolved. Thanks.