Copy row data another worksheet in columns

[echane]

Help, I'm trying to get data from a summary sheet (in rows) into separate worksheets displayed as columns for each record. Except, i'm not savvy enough to get the data to populate into the next empty column for each additional set of data that should show up on that tab. Right now, it just overwrites the same column.

Also, if I need to add new rows into the summary sheet, how do I get it to just copy what was added so nothing before gets overwritten (I want to be able to filter the summary sheet). Row 4 of each tab will never have the same value twice in any worksheet if that helps.

I've only been learning for about two weeks so I only know how to do things the long way. If there's a much quicker way to write the below than just repeating the same lines of code over and over again, I would much appreciate it.

I've attached the excel of what the code is for which contains a tab of ideally what I want the results to be.

Thanks in advance!

Public Sub Populate()
' I'm trying to populate data from a summary tab to separate tabs using the worksheet names.
' However some data can appear on more than one tab. I've indicated in columns C thru F
' which tabs they should go to. Is there a cleaner way to do this than to just repeat the same
' code for four times (one for each column)?
Const CheckColumn1 As String = "C"
Const CheckColumn2 As String = "D"
Const CheckColumn3 As String = "E"
Const CheckColumn4 As String = "F"

Dim i As Long

Dim LastRow1 As Long
Dim LastRow2 As Long
Dim LastRow3 As Long
Dim LastRow4 As Long


Dim sh As Worksheet

Set sh = Sheet4
With sh

LastRow1 = .Cells(.Rows.Count, CheckColumn1).End(xlUp).Row
LastRow2 = .Cells(.Rows.Count, CheckColumn2).End(xlUp).Row
LastRow3 = .Cells(.Rows.Count, CheckColumn3).End(xlUp).Row
LastRow4 = .Cells(.Rows.Count, CheckColumn4).End(xlUp).Row

For i = 7 To LastRow1

.Cells(i, "C").Copy
Sheets(.Cells(i, "C").Value).Select
ActiveSheet.Range("B3").PasteSpecial Paste:=xlPasteValues
' I'm having trouble with this part. I want the next entry to be in the next column rather than
' overwriting the same column. So a row of data from the summary tab is in column B and the next
' row will be in Column C and so on. Row 4 of each tab can be used to test for the next empty column
' since it will always be populated.

.Cells(i, "B").Copy
Sheets(.Cells(i, "C").Value).Select
ActiveSheet.Range("B4").PasteSpecial Paste:=xlPasteValues

Next i

For i = 7 To LastRow2

.Cells(i, "D").Copy
Sheets(.Cells(i, "D").Value).Select
ActiveSheet.Range("B3").PasteSpecial Paste:=xlPasteValues

.Cells(i, "B").Copy
Sheets(.Cells(i, "D").Value).Select
ActiveSheet.Range("B4").PasteSpecial Paste:=xlPasteValues

Next i
' And so on for columns E and F...
End With
End Sub