Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

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