Forum Discussion

_Random_Excel_User_'s avatar
_Random_Excel_User_
Copper Contributor
Sep 16, 2022

VBA code help needed

Hello, I have been trying to figure out a simpler way to copy information over from one worksheet that the data changes on daily, over to another worksheet that compiles the information for each day of the month. Currently I manually enter the 14 numbers from one worksheet over to the other worksheet. I'm new to using Macros, so I'm trying to learn.

 

Here are the cells that I need to copy over...

From Worksheet “Chemical Calculator” --> Worksheet “September” on command

 

B4 --> B (next empty Line)

B9 --> H(next empty Line)

B10 --> I(next empty Line)

B11 --> J(next empty Line)

B12 --> K(next empty Line)

B13 --> L(next empty Line)

B15 --> M(next empty Line)

B17 --> O(next empty Line)

B18 --> P(next empty Line)

B19 --> Q(next empty Line)

B10 --> R(next empty Line)

B22 --> AA(next empty Line)

B23 --> AC(next empty Line)

B24 --> AD(next empty Line)

B26 --> AF(next empty Line)

 

I would greatly appreciate some help to with this because it has been driving me crazy for awhile now.

Thanks in advance!

excel
Macros and VBA
office 365

7 Replies

  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Sep 16, 2022

    _Random_Excel_User_ 

    You have B10 twice. Shouldn't the second one be B20 or B21? If so, change the code below accordingly.

    Sub CopyData()
    Dim ws As Worksheet
    Dim wt As Worksheet
    Dim r As Long
    Dim aRows As Variant
    Dim aCols As Variant
    Dim i As Long
    Application.ScreenUpdating = False
    aRows = Array(4, 9, 10, 11, 12, 13, 15, 17, 18, 19, 10, 22, 23, 24, 26)
    aCols = Array("B", "H", "I", "J", "K", "L", "M", "O", "P", "Q", "R", "AA", "AC", "AD", "AF")
    Set ws = Worksheets("Chemical Calculator")
    Set wt = Worksheets("September")
    r = wt.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    For i = LBound(aRows) To UBound(aRows)
        wt.Range(aCols(i) & r).Value = ws.Range("B" & aRows(i)).Value
    Next i
    Application.ScreenUpdating = True
End Sub
      • HansVogelaar's avatar
        HansVogelaar
        MVP
        Sep 20, 2022

        _Random_Excel_User_ 

        Thank you for your private message. The layout of the September sheet is partly different from your description in the first post, so the code had to be modified. I also made it a bit simpler for you to read and adjust, if necessary.

        Sub CopyData()
    Dim ws As Worksheet
    Dim wt As Worksheet
    Dim rng As Range
    Dim r As Long
    Application.ScreenUpdating = False
    Set ws = Worksheets("Inventory Summary")
    Set wt = Worksheets("September")
    Set rng = wt.Range("A:A").Find(What:=ws.Range("H3").Value, LookIn:=xlValues, LookAt:=xlWhole)
    If rng Is Nothing Then
        MsgBox "Date not found!", vbCritical
    Else
        r = rng.Row
        wt.Range("D" & r).Value = ws.Range("B4").Value
        wt.Range("E" & r).Value = ws.Range("B5").Value
        wt.Range("F" & r).Value = ws.Range("B6").Value
        wt.Range("H" & r).Value = ws.Range("B9").Value
        wt.Range("I" & r).Value = ws.Range("B10").Value
        wt.Range("J" & r).Value = ws.Range("B11").Value
        wt.Range("K" & r).Value = ws.Range("B12").Value
        wt.Range("L" & r).Value = ws.Range("B13").Value
        wt.Range("N" & r).Value = ws.Range("B15").Value
        wt.Range("O" & r).Value = ws.Range("B17").Value
        wt.Range("P" & r).Value = ws.Range("B18").Value
        wt.Range("Q" & r).Value = ws.Range("B19").Value
        wt.Range("R" & r).Value = ws.Range("B20").Value
        wt.Range("S" & r).Value = ws.Range("B21").Value
        wt.Range("T" & r).Value = ws.Range("B22").Value
        wt.Range("V" & r).Value = ws.Range("B23").Value
        wt.Range("W" & r).Value = ws.Range("B24").Value
        wt.Range("Y" & r).Value = ws.Range("B26").Value
    End If
    Application.ScreenUpdating = True
End Sub

        See the attached version, now a macro-enabled workbook (.xlsm). You'll have to allow macros when you open it.

    • _Random_Excel_User_'s avatar
      _Random_Excel_User_
      Copper Contributor
      Sep 16, 2022
      Wow, that looks so confusing, I wish I could understand the coding language more.
      I will try it now. Thank you so much, I will update you once I try it!

Resources