Need help copying data

[OfficeUser]

I need to copy data from one sheet to another. I use this code to find the first empty row.

Sub MoveTrackingData()
    Worksheets("Main").Range("B2").Copy
    Worksheets("Track").Select
    Range("A1000").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
End Sub

Cell B2 on "Main" will always hold a value so it will always be copied to the first empty cell in column A on sheet "Track". I also would like to copy all the values held in B3:B10, B12 to the same row on the sheet "Track".

I could write a similar macro for each cell I need to copy but not every cell on "Main" will always have a value, so my data would end up getting jumbled. How do I say that when it finds the first empty row, for example if its row 46, so that "Track"A46 = "Main"B2, "Track"B46 = "Main"B3 , "Track"C46 = "Main"B4, and so on?

Thanks.

 

[OfficeUser]

For what it's worth, here's a non-looping way that seems to work as well:

Public Sub OfficeUser_No_Loop()
Dim LR  As Long, _
    LR2 As Long
 
LR = Sheets("Main").Range("A" & Rows.Count).End(xlUp).Row
LR2 = Sheets("Track").Range("A" & Rows.Count).End(xlUp).Row + 1
Application.ScreenUpdating = False
Sheets("Main").Range("$B$1:$B$" & LR).AutoFilter Field:=1, Criteria1:="<>"
Sheets("Main").Range("B2:B" & LR).Copy
Sheets("Track").Range("B" & LR2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
Sheets("Main").AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

Should be a bit faster than the looping method above.

Thanks, I will give it a go as well.

 

[OfficeUser]

Try:

Public Sub OfficeUser()
Dim i   As Long, _
    LR  As Long, _
    LR2 As Long, _
    col As Long
 
col = 1
LR = Sheets("Main").Range("A" & Rows.Count).End(xlUp).row
LR2 = Sheets("Track").Range("A" & Rows.Count).End(xlUp).row + 1
Application.ScreenUpdating = False
For i = 2 To LR
    If Sheets("Main").Range("B" & i).Value <> "" Then
        Sheets("Track").Range("B" & i).Copy
        Sheets("Track").Cells(LR2, col).PasteSpecial Paste:=xlValues
        col = col + 1
    End If
Next i
Application.ScreenUpdating = True
End Sub

I found a hiccup. I there is nothing in "Main"B6 then it will not leave the corresponding cell on "Track" blank, causing all my data from the point on to fall into the wrong column.

 

[MrKowz]

I thought you only wanted populated cells to copy over. If you want to hold a spot for every cell, and populate only the ones that have a corresponding value, use:

Public Sub OfficeUser()
Dim i   As Long, _
    LR  As Long, _
    LR2 As Long, _
    col As Long
 
col = 1
LR = Sheets("Main").Range("A" & Rows.Count).End(xlUp).row
LR2 = Sheets("Track").Range("A" & Rows.Count).End(xlUp).row + 1
Application.ScreenUpdating = False
For i = 2 To LR
    If Sheets("Main").Range("B" & i).Value <> "" Then
        Sheets("Track").Range("B" & i).Copy
        Sheets("Track").Cells(LR2, col).PasteSpecial Paste:=xlValues
    End If
    col = col + 1
Next i
Application.ScreenUpdating = True
End Sub