VBA code help needed

Copper Contributor

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!

7 Replies

@_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
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!

@Hans Vogelaar The macro didn't do anything when I ran it and I'm not sure how to troubleshoot the macro.

@_Random_Excel_User_ 

Could you attach a sample workbook (without sensitive data), or if that is not possible, make it available through OneDrive, Google Drive, Dropbox or similar? Alternatively, you can attach it to a private message to me. Thanks in advance.

@_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.

Am I able to run the macro from the PERSONAL worksheet so the file doesn't have to be saved as macro-enabled workbook? My company won't let me save the file as .xlsm.

@_Random_Excel_User_ 

Yes, you can store the macro in a module in your PERSONAL.XLSB workbook.

Make sure that the target workbook is the active workbook when you run the macro.