Thread: Pasting cells from one worksheet into another

Hi,
Can anyone help me? SEE ATTACHED SPREADSHEET FOR EXAMPLE OF PROBLEM.
I want to paste cells from one sheet into another but when I do I want to paste the cells into the "College" column (Far left column in the green TAB : Required Format) so that the data acts as if I have iinserted an equivalent number of rows. The data is sourced from from the blue TAB : Transposed Data. Currently I have to insert the equivalent blank rows first and then paste the data in from the other sheet (very laborious). ANy help would be greatly appreciated.
John Ivanac
Sydney Australia

Try this macro on your sheet as it exists now...

Option Explicit

Sub CollegeReport()
'JBeaucaire  (11/4/2009)
Dim LC As Long, LR As Long, NR As Long, i As Long
Dim ws As Worksheet

'Setup
    Application.ScreenUpdating = False
    Sheets("Transposed Data").Activate
    LC = Cells(2, Columns.Count).End(xlToLeft).Column
    Set ws = Sheets("Required Format")
    ws.Range("A2:F" & Rows.Count).Clear
    NR = 2
    Range("A2").AutoFilter
    
'Create report
    For i = 3 To LC Step 5
        Range("A2").AutoFilter Field:=i, Criteria1:="<>"
        LR = Cells(Rows.Count, i).End(xlUp).Row
        If LR > 2 Then
            ws.Range("B" & NR) = Cells(1, i - 1)
            ws.Range("B" & NR).Font.Bold = True
            ws.Range("B" & NR).WrapText = True
            Range("A3:A" & LR).SpecialCells(xlCellTypeVisible).Copy ws.Range("A" & NR + 1)
            Range(Cells(3, i), Cells(LR, i + 2)).SpecialCells(xlCellTypeVisible).Copy ws.Range("C" & NR + 1)
            NR = ws.Range("A" & Rows.Count).End(xlUp).Row + 2
        End If
        Range("A2").AutoFilter
    Next i

'Cleanup
    ActiveSheet.AutoFilterMode = False
    
    ws.Activate
    Range("A2").Select
    ActiveWindow.FreezePanes = True
    Columns("C:E").HorizontalAlignment = xlRight
    Cells.Rows.AutoFit
    Application.ScreenUpdating = True
End Sub

You can change the sheet names in red if needed.
=========
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 CollegeReport from the macro list.

Use this version:

Option Explicit

Sub CollegeReport()
'JBeaucaire  (11/5/2009)
Dim LC As Long, LR As Long, NR As Long, i As Long
Dim ws As Worksheet

'Setup
    Application.ScreenUpdating = False
    Sheets("Transposed Data").Activate
    LC = Cells(2, Columns.Count).End(xlToLeft).Column
    Set ws = Sheets("Final Format")
    ws.Range("A2:F" & Rows.Count).Clear
    NR = 2
    Range("A2").AutoFilter
    
'Create report
    For i = 3 To LC Step 5
        Range("A2").AutoFilter Field:=i, Criteria1:="<>"
        LR = Cells(Rows.Count, i).End(xlUp).Row
        If LR > 2 Then
            ws.Range("B" & NR) = Cells(1, i - 1)
            ws.Range("B" & NR).Font.Bold = True
            ws.Range("B" & NR).WrapText = True
            Range("A3:A" & LR).SpecialCells(xlCellTypeVisible).Copy ws.Range("A" & NR + 1)
            Range(Cells(3, i), Cells(LR, i + 2)).SpecialCells(xlCellTypeVisible).Copy ws.Range("C" & NR + 1)
            NR = ws.Range("A" & Rows.Count).End(xlUp).Row + 2
            ws.Range("C" & NR - 1) = "TOTAL:  " & WorksheetFunction.Sum(Columns(i).SpecialCells(xlCellTypeVisible))
            ws.Range("C" & NR - 1).Font.Bold = True
            ws.Range("C" & NR - 1).Borders(xlEdgeTop).Weight = xlThin
        End If
        Range("A2").AutoFilter
    Next i

'Cleanup
    ActiveSheet.AutoFilterMode = False
    
    ws.Activate
    Range("A2").Select
    ActiveWindow.FreezePanes = True
    Columns("C:E").HorizontalAlignment = xlRight
    With Range("C" & NR)
        .Value = WorksheetFunction.Sum(Range("C:C"))
        .Borders.Weight = xlThick
        .Interior.ColorIndex = 45
        .Font.Size = 20
        .Font.Bold = True
    End With
    Range("A" & NR) = "Total Enrollments"
    Range("A" & NR).Interior.ColorIndex = 34
    Cells.Rows.AutoFit
    Application.ScreenUpdating = True
End Sub

If that takes care of your need, be sure to EDIT your original post, click Go Advanced and mark the PREFIX box [SOLVED].


(Also, use the blue "scales" icon in our posts to leave Reputation Feedback, it is appreciated)