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.

 

[asking]

See if this works for you.

Sub MoveTrackingData()
    Worksheets("Main").Range("B2:B10").Copy
    Worksheets("Track").Select
    Range("A1000").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Worksheets("Main").Range("B12").Copy
     Range("A1000").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(0, 9).Select
    Selection.PasteSpecial Paste:=xlPasteValues
End Sub

 

[MrKowz]

To clarify, you want to find every non-blank value in column B in "Main" and want to paste them across the last row in "Track"?

 

[OfficeUser]

To clarify, you want to find every non-blank value in column B in "Main" and want to paste them across the last row in "Track"?

Yes, that is correct.

 

[MrKowz]

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 Destination:=Sheets("Track").Cells(LR2, col)
        col = col + 1
    End If
Next i
Application.ScreenUpdating = True
End Sub

 

[OfficeUser]

MrKowz:

This works after a slight correction to sheet names. The only thing I see not working is that when it copies the values in "Main" B5 & B6, it is not showing the true values in the cells on the "Track" sheet. This could be because "Main" B5 & B6 have a simply formula in them such as =B30 and
=B31. Thanks.

 

[OfficeUser]

See if this works for you.

Sub MoveTrackingData()
    Worksheets("Main").Range("B2:B10").Copy
    Worksheets("Track").Select
    Range("A1000").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Worksheets("Main").Range("B12").Copy
     Range("A1000").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(0, 9).Select
    Selection.PasteSpecial Paste:=xlPasteValues
End Sub

This works good but the value in "Main"B12 is not copieed over to "Track"...? Thanks.

 

[MrKowz]

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

 

[OfficeUser]

That did the trick. I was fairly close in getting to a solution myself. I had a few errors but was on the right track. Thanks to you both for helping.

 

[sous2817]

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.