Input Range to Get Data and Store it in Another Tab in Excel

0

Hi I try to make a sheet like the example was posted a few weeks ago, to input data in a form and store it in another tab,          https://www.teachexcel.com/excel-tutorial/input-form-to-get-data-and-store-it-in-another-tab-in-excel_1570.html?nav=email,      but I want to do it with a range of cells, let's say the input is in sheet1 in cells B2:B20, and I want to store it in another tab, but I can't figure out how to make it, can someone help me please?

thank you

Option Explicit
Sub test()
    Dim ws_input As String
    Dim ws_timein As String
    Dim ws_timeout As String
    Dim ws_missing As String

    Dim next_column  As Integer

    'This is the shhet names
    ws_input = "Input"
    ws_timein = "Time In"
    ws_timeout = "Time Out"
    ws_missing = "Missing"


next_column = Sheets(ws_timein).Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).Column 'this line find out what the next empty column
    Sheets(ws_timein).Cells(1, next_column).Value = Range("date").Value '"date" is a Name Manager for the date cell
    Sheets(ws_timein).Cells(2, next_column).Value = Range("time_in").Value '"time_in" is a Name Manager for column B

next_column = Sheets(ws_timeout).Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).Column
    Sheets(ws_timeout).Cells(1, next_column).Value = Range("date").Value
    Sheets(ws_timeout).Cells(2, next_column).Value = Range("time_out").Value '"time_out" is a Name Manager for column C

next_column = Sheets(ws_missing).Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).Column
    Sheets(ws_missing).Cells(1, next_column).Value = Range("date").Value
    Sheets(ws_missing).Cells(2, next_column).Value = Range("missing").Value  '"missing" is a Name Manager for column D

    'This lines clears the date cell and the ranges to be ready for the new data
    Range("date").ClearContents
    Range("time_in").ClearContents
    Sheets(ws_input).Range("B2").Value = "Time In"  'this line set the title for column B

    Range("date").ClearContents
    Range("time_out").ClearContents
    Sheets(ws_input).Range("C2").Value = "Time Out"

    Range("date").ClearContents
    Range("missing").ClearContents
    Sheets(ws_input).Range("D2").Value = "Missing"

End Sub

instead to make --Cells(2, next_column) -- what gives me only 1 cell I need a range of 20 cells

,

Answer
Discuss

Answers

0
Selected Answer

I'm not sure I understood your intention correctly but you might try the following code. It is implemented in the attached workbook. Follow this sequence of operation:-

  1. Look at the 3 Output sheets.
  2. Set the date on the Input sheet.
  3. Press the 'Submit' button
  4. Repeat from step 1
Sub PostTimesToWorksheets()
    ' 06 Sep 2017
    
    Dim WsInput As Worksheet
    Dim WsOutput As Worksheet                   ' assign various sheets to this variable
    Dim SheetNames() As String
    Dim Dat As Date                             ' the date from WsInput
    Dim CopyRng As Range, TargetRng As Range
    Dim Cout As Long                            ' Destination column
    Dim Rl As Long                              ' Last row in WsInput
    Dim C As Long                               ' CopyRange column
    
    Set WsInput = Worksheets("Input")
    ' pay attention to the sequence which must be the same as
    ' that of the columns in WsInput.
    ' Observe: SheetNames(0) refers to WsInput.Columns("B")
    '          Therefore Column number = Array index + 2
    SheetNames = Split("Time In,Time Out,Missing", ",")
    With WsInput
        Dat = .Cells(1, 3).Value                ' this will fail if C1 isn't a true date
        Rl = .Cells(.Rows.Count, 1).End(xlUp).Row
        For C = 2 To 4                          ' copy one column at a time
            ' start copying from row 3:
            Set CopyRng = .Range(.Cells(3, C), .Cells(Rl, C))
            Set WsOutput = Worksheets(SheetNames(C - 2))
            Cout = TargetColumn(WsOutput, Dat)
            ' past to row 3 in WsOutput
            CopyRng.Copy Destination:=WsOutput.Cells(3, Cout)
        Next C
    End With
End Sub
Private Function TargetColumn(Ws As Worksheet, _
                              Dat As Date) As Long
    ' 06 Sep 2017
    ' return the column with 'Dat' date in row 1
    ' or add 'Dat' to the next blank column and return its number
    ' 'Dat' must be a valid date
    
    Dim C As Long
    
    C = 2                                     ' first eligible column
    Do
        With Ws.Cells(1, C)                   ' dates are in row 1
            If (.Value = "") Then
                .Value = Dat
                .EntireColumn.AutoFit
            End If
            If (.Value = Dat) Then Exit Do
            C = C + 1
        End With
    Loop
    TargetColumn = C
End Function
Discuss

Discussion

This is Exactly what I want
JAExcel (rep: 10) Sep 6, '17 at 11:56 am
Add to Discussion

Answer the Question

You must create an account to use the forum. Create an Account or Login