Sep 16 2022 01:18 PM - edited Sep 16 2022 01:44 PM
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!
Sep 16 2022 01:46 PM
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
Sep 16 2022 01:51 PM
Sep 16 2022 03:45 PM
@Hans Vogelaar The macro didn't do anything when I ran it and I'm not sure how to troubleshoot the macro.
Sep 16 2022 11:32 PM
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.
Sep 20 2022 04:09 AM
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.
Sep 20 2022 04:38 AM
Sep 20 2022 04:41 AM
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.