Copy Cells to Sheet Based on Column Name

xchanyazy · Jun 14th 2012

Hi,
Very new to VBA, and have been searching but not finding enough to cobble together what I am looking for. My end goal is to parse the data on the attached sheet and copy the building, room number, and date (data in columns a through c) to the appropriate sheet (titled after the column header in D-DH) if there is a 1 present in said row and column. Therefore, with the attached sheet, the resulting workbook would list:
builda 4002T 12-Jun
builda 4006T 12-Jun
builda 3002T 12-Jun
builda 3010T 12-Jun
in the Doorframepaintinc sheet.
I found the following code from http://www.ozgrid.com/forum/showthread.php?t=31461"]this thread that would do it for one column at a time, I was wondering if there was a way to automate it further or if I needed to create 109 for loops. I'm also trying to figure out how to replace the cell.EntireRow.copy with just the first three columns of said row if I need to go this way.

Code

Macro3() 
Dim rngA Range 
Dim cell as Range 
     
 Set rngA = Range("D1", Range("D65536").End(xlUp)) 
    For Each cell rngA 
       cell.Value = "1" Then
            cell.EntireRow.Copy 
            Windows("Results.xls").Activate 
            Sheets("Doorframepaintinc").Range("A65536").End(xlUp).Offset(1, 0).Select 
            ActiveSheet.Paste 
     Next cell 
     
End Sub

Display More

Thanks for any help you can give me.

forum.ozgrid.com/index.php?attachment/46441/

dangle · Jun 14th 2012

Re: Copy Cells to Sheet Based on Column Name

Something like this maybe:

Code

Sub SheetCopier()
Dim a, i As Long, ws As Worksheet
a = Range("A1").CurrentRegion.Value
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 4 To UBound(a, 2)
    Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    ws.Name = (a(1, i))
    With Sheets("Dorm Bathrooms Checklist")
        .Range("A1").AutoFilter field:=i, Criteria1:="1"
        .Range("A1:C" & UBound(a, 1)).Copy ws.Range("A1")
        .Range("A1").AutoFilter
    End With
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set ws = Nothing
End Sub

Display More

xchanyazy · Jun 15th 2012

Re: Copy Cells to Sheet Based on Column Name

Wow, that is perfect. Thank you very much!

Copy Cells to Sheet Based on Column Name

Participate now!

Share