VBA code help needed

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

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.

Chemical Inventory Simple.xlsm26 KB

_Random_Excel_User_
Copper Contributor
Sep 20, 2022
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.
- HansVogelaar
  MVP
  Sep 20, 2022
  _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.

HansVogelaar
MVP
Sep 17, 2022
_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.

Forum Discussion

Resources