Results 1 to 3 of 3

Thread: Transferring data to a summary spreadsheet

  1. #1

    Question Transferring data to a summary spreadsheet

    Hello. I would very appreciative for some code help. File attached.

    I have some code that at the press of a button, copies text from one column in an input worksheet to a summary worksheet. (The summary worksheet accumulates all new input text that is entered.)

    My problem is that there are times when I have parts of a second column (and third and fourth column etc) that I would also like to copy across when there is data in those columns.

    I am hoping someone can help me in my efforts to transfer across this second column data (and other populated columns) to the summary worksheet in the same way the first column is transferred across. I have failed in my attempts.

    Thank you so much for any assistance.
    Attached Files Attached Files

  2. #2
    VBAX Expert
    Sep 2016
    Sub UpdateLogWorksheet()
        Dim historyWks As Worksheet
        Dim inputWks As Worksheet
        Dim nextRow As Long
        Dim oCol As Long
        Dim myRng As Range
        Dim myCopy As String
        Dim myCell As Range
        Dim myCopy2 As String
        Dim myRng2 As Range
        Dim off As Long
        myCopy = "D5,D7,D9,D11,D13,D15,D17,D19,D21,D23,D25,D27,D29,D31,D33,D35,D37,D39,D41,D43,D45,D47,D49,D51,D53,D55,D57,D59"
        myCopy2 = "D23,D25,D27,D29,D31,D33"
        Set inputWks = Worksheets("Input")
        Set historyWks = Worksheets("Total")
        With historyWks
            nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
        End With
        With inputWks
            Set myRng = .Range(myCopy)
            Set myRng2 = .Range(myCopy2)
            If Application.CountA(myRng) <> myRng.Cells.Count Then
                MsgBox "Please fill in all the cells!"
                Exit Sub
            End If
        End With
        With historyWks
            With .Cells(nextRow, "A")
                .Value = Now
                .NumberFormat = "dd/mm/yyyy hh:mm:ss"
            End With
            .Cells(nextRow, "B").Value = Application.UserName
            oCol = 3
            For Each myCell In myRng.Cells
                .Cells(nextRow, oCol).Value = myCell.Value
                oCol = oCol + 1
            Next myCell
                off = off + 2
                Set myRng2 = myRng2.Offset(, off)
                If WorksheetFunction.CountA(myRng2) < 1 Then Exit Do
                nextRow = nextRow + 1
                With .Cells(nextRow, 1).Resize(, 11)
                    .Value = .Offset(-1).Value
                End With
                oCol = 12
                For Each myCell In myRng2.Cells
                    .Cells(nextRow, oCol).Value = myCell.Value
                    oCol = oCol + 1
                Next myCell
        End With
        Application.GoTo inputWks.Cells(1)
    End Sub

  3. #3
    Perfect. Thank you so much for the prompt assistance.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts