VBA code to copy a one cell and a range of cells in one column to another sheet

[bdt]

Hi, absolute novice with VBA and first post so please be gentle.
I have a work sheet (ABACUS) that has a cell (C2) with a week ending date and a range of cells (AX22:AX32) that have a number in them. I would like to run some VBA code to copy this data into another sheet (OVERTIME) with the cell C2 being added to column A and (AX22:AX32) being added to columns B to L in the same row.
The following week ending the same data would be added to OVERTIME but the row below.
Is this even possible? Any guidance much appreciated. Thanks

 

[Skyybot]

Alt-F11 to open the VBA Project Model. Double click ThisWorkbook of your open workbook. Paste the following code in it and hit F5.

Option Explicit

Sub pasteRange()

Dim wb As Workbook, aSht As Worksheet, oSht As Worksheet, rng As Range, kWrd, cell As Range
Dim i

Set wb = ThisWorkbook: Set aSht = wb.Sheets("ABACUS")
Set rng = aSht.Range("AX22", "AX32")
kWrd = aSht.Cells(2, 3)
i = 2

Set oSht = Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))


With oSht
    .Cells(1, 1) = kWrd
    For Each cell In rng
       .Cells(1, i) = cell.Value
       i = i + 1
    Next cell
    .Name = "OVERTIME"
End With



End Sub

 

[NoSparks]

another option, assuming your OVERTIME sheet already exists
paste this into a standard module

Sub bdt()
    Dim WKend As Date
    Dim arr As Variant
    Dim writerow As Long
    
With Sheets("ABACUS")
    WKend = .Range("C2").Value
    arr = .Range("AX22:AX32").Value
End With

With Sheets("OVERTIME")
    ' last used row in column A plus 1
    writerow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
    .Range("A" & writerow) = WKend
    .Range("B" & writerow).Resize(, UBound(arr)).Value = Application.Transpose(arr)
End With

End Sub

 

[bdt]

another option, assuming your OVERTIME sheet already exists
paste this into a standard module

Sub bdt()
    Dim WKend As Date
    Dim arr As Variant
    Dim writerow As Long
   
With Sheets("ABACUS")
    WKend = .Range("C2").Value
    arr = .Range("AX22:AX32").Value
End With

With Sheets("OVERTIME")
    ' last used row in column A plus 1
    writerow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
    .Range("A" & writerow) = WKend
    .Range("B" & writerow).Resize(, UBound(arr)).Value = Application.Transpose(arr)
End With

End Sub

No sparks, this code works lovely except when pasting the date, formatted to **.**.** it pastes it into column A in time format. If I format the entire column to date **.**.** it returns a date of 0.1.00 every time.
Is there a way to correct this
Thanks

 

[Alex Blakenburg]

Click in the cell C2 and show us a picture that includes the Cell AND the formula bar.
Also change the date format in C2 and tell us if the display changes to the new format or stays the same.

 

[bdt]

Cell C2 is formatted to date **.*.**

19.10.24

and the destination column is formatted the same. but returns in the formula bar

00/01/1900 17:10:24

And shows below in the A column

0.1.00

any thoughts gratefully received, thanks

 

[NoSparks]

Because WKend is declared as Date
C2 must be a real date or you would be getting Run Time error 13: Type mismatch
so I'm thinking it must be the formatting of column A

try changing the formatting of the next cells in column A to General
and try this, it should be 45584 decimal something you see in the cell
which you can then format to display the date as whatever you want.

Sub bdt()
    Dim WKend
    Dim arr As Variant
    Dim writerow As Long
    
With Sheets("ABACUS")
    WKend = .Range("C2").Value2
    arr = .Range("AX22:AX32").Value
End With

With Sheets("OVERTIME")
    ' last used row in column A plus 1
    writerow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
    .Range("A" & writerow) = WKend
    .Range("B" & writerow).Resize(, UBound(arr)).Value = Application.Transpose(arr)
End With

End Sub

let me know how that goes

 

[NoSparks]

Cell C2 is formatted to date **.*.**

Why are you not showing your formatting as d, m and y

 

[bdt]

Because WKend is declared as Date
C2 must be a real date or you would be getting Run Time error 13: Type mismatch
so I'm thinking it must be the formatting of column A

try changing the formatting of the next cells in column A to General
and try this, it should be 45584 decimal something you see in the cell
which you can then format to display the date as whatever you want.

Sub bdt()
    Dim WKend
    Dim arr As Variant
    Dim writerow As Long
   
With Sheets("ABACUS")
    WKend = .Range("C2").Value2
    arr = .Range("AX22:AX32").Value
End With

With Sheets("OVERTIME")
    ' last used row in column A plus 1
    writerow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
    .Range("A" & writerow) = WKend
    .Range("B" & writerow).Resize(, UBound(arr)).Value = Application.Transpose(arr)
End With

End Sub

let me know how that goes

NoSparks you are a hero. Formatted column A in OVERTIME to general and it now returns the date format I was after.
Many thanks

 

[NoSparks]

You're welcome, glad I could help.