CODEWITHSUNDEEP
vbaexcel
fouriec
fouriec

Reputation: 1

VBA - Copy specific value from one sheet column to next sheet row

I need help please, I have 2 sheet, in the first sheet I record time against different numbers (1 to 50), I want to copy the time stamp over to a new sheet against the same number. Sheet 1: Sheet 1 example

Sheet 2: Sheet 2 example

Please help with a VBA code to get this done automatically.

Sub mytry()
Dim lRow As Long
Dim lRow1 As Long
Dim time1 As Date

Sheets("Time").Select

lRow = Range("A" & Rows.Count).End(xlUp).Row

For iCntr = 2 To lRow

num1 = Cells(iCntr, 1)

    Sheets("Rec").Select
    lRow1 = Range("A" & Rows.Count).End(xlUp).Row
    For iCntr2 = 2 To lRow1
        If Cells(iCntr2, 1) = num1 Then
            time1 = Cells(iCntr2, 2)
            Sheets("Time").Select
            For t1 = 2 To 20
            If Cells(iCntr, t1) = "" Then
            Cells(iCntr, t1) = time1
            End If
            GoTo 1

            Next t1
             1
            Sheets("Rec").Select

        End If


    Next iCntr2

Sheets("Time").Select
Next iCntr

End Sub

Upvotes: 0

Views: 120

Answers (1)

Cyril
Cyril

Reputation: 6829

This isn't the prettiest thing I've done, but I'm going to try...

You may want to think about adding a few variables, since you know where some items are going to be on Sheets("Rec"):

Dim i as integer
Dim lRow as Long 'Specific to Sheets("Time")
Dim LC1 as Long, LC2 as Long, LC3 as Long 'Up to LC9 in the example for Last Column for Row #

Taking what you have and rolling with it, to loop through Sheets("Time"):

lRow = Sheets("Time").Range("A" & Sheets("Time").Rows.Count).End(xlUp).Row

For i = 2 to lRow

I would recommend avoiding the sheet select at the start and specifying the sheets by name as you go, or using With statements (the latter might not work as smoothly for the path I'm going with Select Case).

You can then use a Select Case inside of the loop equivalent to your Number count, e.g., 9 from the example.

Select Case Cells(i,1).Value

Case 1
   LC1=Sheets("Rec").Cells(2, Sheets("Rec").Columns.Count).End(xlToLeft).Column 
   Sheets("Time").Cells(i,2).Copy Sheets("Rec").Cells(2,LC1)

Case 2
   LC2=Sheets("Rec").Cells(3, Sheets("Rec").Columns.Count).End(xlToLeft).Column 
   Sheets("Time").Cells(i,2).Copy Sheets("Rec").Cells(3,LC2)

Case 3
   LC3=Sheets("Rec").Cells(4, Sheets("Rec").Columns.Count).End(xlToLeft).Column 
   Sheets("Time").Cells(i,2).Copy Sheets("Rec").Cells(4,LC3)

End Select

Then you should be able to have it run pretty smooth, making sure to Next i. It all comes together looking like:

Dim i as integer
Dim lRow as Long 
Dim LC1 as Long, LC2 as Long, LC3 as Long 

lRow1 = Sheets("Time").Range("A" & Sheets("Time").Rows.Count).End(xlUp).Row

For i = 2 to lRow

Select Case Cells(i,1).Value

Case 1
   LC1=Sheets("Rec").Cells(2, Sheets("Rec").Columns.Count).End(xlToLeft).Column 
   Sheets("Time").Cells(i,2).Copy Sheets("Rec").Cells(2,LC1)

Case 2
   LC2=Sheets("Rec").Cells(3, Sheets("Rec").Columns.Count).End(xlToLeft).Column 
   Sheets("Time").Cells(i,2).Copy Sheets("Rec").Cells(3,LC2)

Case 3
   LC3=Sheets("Rec").Cells(4, Sheets("Rec").Columns.Count).End(xlToLeft).Column 
   Sheets("Time").Cells(i,2).Copy Sheets("Rec").Cells(4,LC3)

End Select

Next i

Upvotes: 0

Related Questions