Question

I have a MAIN worksheet where I enter the following:

Name    5AM  8AM  3PM  Room  Comment
John     X              1A    Blah    
Peter    X    X    X    2B    Some Blah
Ann           X         3C    Some more Blah

Aside from worksheet MAIN, I have 3 others according to the time. In other words, the other worksheet names are 5AM, 8AM, and 3PM. Basically, I am trying to fill each worksheet given the corresponding time marked with an X.

So Worksheet 5AM should have the following.

Name    Room  Comment
John     1A    Blah    
Peter    2B    Some Blah

Worksheet 8AM should have the following.

Name    Room  Comment
Peter    2B    Some Blah
Ann      3C    Some more Blah

Worksheet 3PM should have the following.

Name    Room  Comment
Peter    2B   Some Blah

I started with creating some code in the MAIN worksheet using:

Private Sub Worksheet_Change(ByVal Target As Range)

Sheets("10AM").Range("A1").End(xlup).Offset(1, 0)

End Sub

but it's not really working out.

No correct solution

OTHER TIPS

try this:

Sub test()

Dim ws As Worksheet, fiveAM As Worksheet, eightAM As Worksheet, ninePM As Worksheet
Dim wb As Workbook
Dim lrow As Long, i As Integer
Dim shname As String
Dim columntocopy As Range, rowtocopy As Range, rngtocopy As Range

Set wb = ThisWorkbook
Set ws = wb.Sheets("MAIN")
Set fiveAM = wb.Sheets("5AM")
Set eightAM = wb.Sheets("8AM")
Set ninePM = wb.Sheets("9PM")
Set columntocopy = ws.Range("A:A,E:E,F:F")

With ws
    lrow = .Range("A" & .Rows.Count).End(xlUp).Row
    For i = 0 To 2
        .AutoFilterMode = False
        shname = .Range("B1").Offset(0, i).Value
        .Range("B1:B" & lrow).Offset(0, i).AutoFilter Field:=1, Criteria1:="X"
        Set rowtocopy = .Range("A1:A" & lrow).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
        Set rngtocopy = Intersect(rowtocopy, columntocopy)
        rngtocopy.Copy
        Select Case shname
        Case "5AM": fiveAM.Range("A" & fiveAM.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Case "8AM": eightAM.Range("A" & eightAM.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Case "9PM": ninePM.Range("A" & ninePM.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End Select
    Next
    .AutoFilterMode = False
End With
Application.CutCopyMode = False
End Sub

I assumed your data in each sheet starts at Column A.
Tried and tested.
I leave the further testing to you.

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top