VBA Copy and Paste Macro doesnt line up correctly

[LostInEverything]

Hi,

To begin with I'm quite new to excel VBA and trying to learn it as I go, so if anyone has good starting points or materials I would love to see them.

But onto my actual question. I am trying to make a spreadsheet that uses a macro to send info form specific cells in another sheet to a second. Now I have managed to make that happen, but the way I have to do it requires me to separate the copy and paste action. Therefore, I am encountering an issue where the data doesnt line up as I want it to.

It comes out like this:

When I need it to look like this:

This is the code I am using:

Sub Copy3()

If IsEmpty(Sheets("SourceSheet").Range("D2:D3").Value) Then
End
Else: Sheets("SourceSheet").Select
Range("D2:D3").Select
Selection.Copy
Sheets("TargetSheet").Select
Sheets("TargetSheet").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

End If

If IsEmpty(Sheets("SourceSheet").Range("B7:C10").Value) Then
End
Else: Sheets("SourceSheet").Select
Range("B7:C10").Select
Selection.Copy
Sheets("TargetSheet").Select
Sheets("TargetSheet").Range("D" & Rows.Count).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

End If

End Sub

If anyone knows a way to solve this, it would be greatly appreciated.

 

[Alex Blakenburg]

Welcome to the Forum.
Please show us what the source data looks like ideally using the Forum's XL2BB to save us having to manually create test data.
If you have to use an image please include the row and column references.

Using XL2BB
MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

 

[LostInEverything]

Book1.xlsm
	A	B	C	D	E	F
1
2		Date		27/05/2024 20:27
3		Seller		Seller1
4		Price		$ 30.00
5
6		product	amount	price
7		Item1	1	20
8		Item2	2	10
9
10
SourceSheet

Cell Formulas
Range	Formula
D2	D2	=NOW()
D4	D4	=SUM(D7:D8)

Cells with Data Validation
Cell	Allow	Criteria
D3	List	Seller1, Seller2

Book1.xlsm
	A	B	C	D	E	F	G
1
2		Date	Seller	Product	Amount	Price
3		27/05/2024 20:27	Seller1	Item1	1
4				Item2	2
5
6
7
8
9
TargetSheet

Cell Formulas
Range	Formula
B3	B3	=NOW()

Cells with Data Validation
Cell	Allow	Criteria
C7	List	Seller1, Seller2
C5	List	Seller1, Seller2
C3	List	Seller1, Seller2

Is this what you meant? Does this help?

 

[Alex Blakenburg]

Yes thanks. Is the next seller directly under that and following the same pattern ?

 

[LostInEverything]

Sorry I completely forgot a piece of information that probably helps. The SourceSheet is meant to act as a sale form where that is the only data on that sheet. the area where it says seller is meant to be able to be swapped between both seller 1 and 2. Additionally there is a save button that runs a macro using the code from earlier next to it, it just didnt copy over for some reason. So basically in sourcesheet you only change out what is needed and hit save and it puts it in targetsheet, however when it runs it comes out with the issue I had in my intital post. If that is clear?

 

[Alex Blakenburg]

If you are happy to preformat the columns in the target sheet eg column B as Date-Time, columns E & F with the appropriate number format, then this might work for you.

Sub CopySalesForm()

    Dim shtSrc As Worksheet, shtTgt As Worksheet
    Dim rowlastSrc As Long, rownextTgt As Long
    Dim rngProductSrc As Range
    
    Set shtSrc = Worksheets("SourceSheet")
    Set shtTgt = Worksheets("TargetSheet")
    
    rowlastSrc = shtSrc.Range("C" & Rows.Count).End(xlUp).Row
    rownextTgt = shtTgt.Range("D" & Rows.Count).End(xlUp).Row + 1
    
    With shtSrc
        Set rngProductSrc = .Range(.Cells(7, "B"), .Cells(rowlastSrc, "D"))
    End With
    
    shtTgt.Cells(rownextTgt, "B").Value2 = shtSrc.Cells(2, "D").Value2
    shtTgt.Cells(rownextTgt, "C").Value2 = shtSrc.Cells(3, "D").Value2
    
    With rngProductSrc
        shtTgt.Cells(rownextTgt, "D").Resize(.Rows.Count, .Columns.Count).Value2 = .Value2
    End With
    
End Sub

 

[LostInEverything]

Yes this works thank you. However, if it isnt too much trouble could i have an explanation on how it works, so that i can utilise it other times and/or add to it in the future. If not that is ok as you have been an incredible help.

 

[Alex Blakenburg]

The target value = source value is the equivalent of PasteSpecial Values but is more efficient.
The code works out what the last row used is in the target sheet using the last cell in column C with data in it. It then adds 1 to that row number and uses that for the output.
If you have specific question I am happy to answer them.

 

[LostInEverything]

Thankyou, you have been a massive help. Was just wondering on a slight change to the code, as I have made a small change to the sheet. therefore certain positionings alter sligthly.

Book1.xlsm
	A	B	C	D	E	F	G	H	I	J	K
1
2		Date		27/05/2024 23:40
3		Seller		Seller1						Item1	1
4		Price		$ 15.40						Item2	2
5		Markup		1.1						Item3	3
6										Item4	4
7		Product	Amount	Price						Item5	5
8		Item1	1	$ 1.10						Item6	6
9		Item2	2	$ 4.40
10		Item3	3	$ 9.90
11				$ -
12				$ -
13				$ -
14				$ -
15				$ -
16				$ -
17				$ -
SourceSheet

Cell Formulas
Range	Formula
D2	D2	=NOW()
D4	D4	=SUM(D8:D17)
D8:D17	D8	=IF(B8=0,0,IF($D$5=0,0,IF(C8=0,0,VLOOKUP(B8,$J$3:$K$8,2,FALSE))*C8*$D$5))

Cells with Data Validation
Cell	Allow	Criteria
D3	List	Seller1, Seller2
B8:B17	List	=$J:$J
D5	List	1, 1.1, 1.2, 1.3, 1.4, 1.5, 1.6, 1.7, 1.8, 1.9, 2

Book1.xlsm
	A	B	C	D	E	F	G	H
1
2		Date	Seller	Product	Amount	Markup	Price	Total
3		27/05/2024	Seller1	Item1	1	1.10	$ 1.10	$ 15.40
4				Item2	2		$ 4.40
5				Item3	3		$ 9.90
TargetSheet

Cells with Data Validation
Cell	Allow	Criteria
C5	List	Seller1, Seller2
C3	List	Seller1, Seller2

I made this change to the code to get the outcome ive shown.

Sub CopySalesForm()

    Dim shtSrc As Worksheet, shtTgt As Worksheet
    Dim rowlastSrc As Long, rownextTgt As Long
    Dim rngProductSrc As Range
    
    Set shtSrc = Worksheets("SourceSheet")
    Set shtTgt = Worksheets("TargetSheet")
    
    rowlastSrc = shtSrc.Range("C" & Rows.Count).End(xlUp).Row
    rownextTgt = shtTgt.Range("D" & Rows.Count).End(xlUp).Row + 1
    
    With shtSrc
        Set rngProductSrc = .Range(.Cells(8, "B"), .Cells(rowlastSrc, "C"))
    End With
    
    shtTgt.Cells(rownextTgt, "B").Value2 = shtSrc.Cells(2, "D").Value2
    shtTgt.Cells(rownextTgt, "C").Value2 = shtSrc.Cells(3, "D").Value2
    shtTgt.Cells(rownextTgt, "H").Value2 = shtSrc.Cells(4, "D").Value2
    shtTgt.Cells(rownextTgt, "F").Value2 = shtSrc.Cells(5, "D").Value2
    
    With rngProductSrc
        shtTgt.Cells(rownextTgt, "D").Resize(.Rows.Count, .Columns.Count).Value2 = .Value2
    End With
    
    With shtSrc
        Set rngProductSrc = .Range(.Cells(8, "D"), .Cells(rowlastSrc, "D"))
    End With
    
    With rngProductSrc
        shtTgt.Cells(rownextTgt, "G").Resize(.Rows.Count, .Columns.Count).Value2 = .Value2
    End With
    
End Sub

But wanted to know if its possible to make it more concise like this, though i believe there is an issue with the 3rd last line

Sub CopySalesForm()

    Dim shtSrc As Worksheet, shtTgt As Worksheet
    Dim rowlastSrc As Long, rownextTgt As Long
    Dim rngProductSrc As Range
    Dim rngProductSrc2 As Range
    
    Set shtSrc = Worksheets("SourceSheet")
    Set shtTgt = Worksheets("TargetSheet")
    
    rowlastSrc = shtSrc.Range("C" & Rows.Count).End(xlUp).Row
    rownextTgt = shtTgt.Range("D" & Rows.Count).End(xlUp).Row + 1
    
    With shtSrc
        Set rngProductSrc = .Range(.Cells(8, "B"), .Cells(rowlastSrc, "C"))
        Set rngProductSrc2 = .Range(.Cells(8, "D"), .Cells(rowlastSrc, "D"))
    End With
    
    shtTgt.Cells(rownextTgt, "B").Value2 = shtSrc.Cells(2, "D").Value2
    shtTgt.Cells(rownextTgt, "C").Value2 = shtSrc.Cells(3, "D").Value2
    shtTgt.Cells(rownextTgt, "H").Value2 = shtSrc.Cells(4, "D").Value2
    shtTgt.Cells(rownextTgt, "F").Value2 = shtSrc.Cells(5, "D").Value2
    
    With rngProductSrc
        shtTgt.Cells(rownextTgt, "D").Resize(.Rows.Count, .Columns.Count).Value2 = .Value2
        shtTgt.Cells(rownextTgt, "G").Resize(.Rows.Count, .Columns.Count).Value2 = .Value2
    End With
    
End Sub

Sorry about how much this is, I just keep wanting to know and change more to make it better

 

[Alex Blakenburg]

It will come down to what you find easier to follow and modify in the future
This is a shorter option
(I have added turning off/on the screenupdating)
Note:
Offset(0,1) -> moves 1 column to the right
Resize(,1) -> changes the number of columns to 1 (was initially 2)

Sub CopySalesForm_OPMod1_adj()

    Dim shtSrc As Worksheet, shtTgt As Worksheet
    Dim rowlastSrc As Long, rownextTgt As Long
    Dim rngProductSrc As Range
    
    Application.ScreenUpdating = False
    
    Set shtSrc = Worksheets("SourceSheet")
    Set shtTgt = Worksheets("TargetSheet")
    
    rowlastSrc = shtSrc.Range("C" & Rows.Count).End(xlUp).Row
    rownextTgt = shtTgt.Range("D" & Rows.Count).End(xlUp).Row + 1
    
    With shtSrc
        Set rngProductSrc = .Range(.Cells(8, "B"), .Cells(rowlastSrc, "C"))
    End With
    
    shtTgt.Cells(rownextTgt, "B").Value2 = shtSrc.Cells(2, "D").Value2
    shtTgt.Cells(rownextTgt, "C").Value2 = shtSrc.Cells(3, "D").Value2
    shtTgt.Cells(rownextTgt, "H").Value2 = shtSrc.Cells(4, "D").Value2
    shtTgt.Cells(rownextTgt, "F").Value2 = shtSrc.Cells(5, "D").Value2
    
    With rngProductSrc
        shtTgt.Cells(rownextTgt, "D").Resize(.Rows.Count, .Columns.Count).Value2 = .Value2
        shtTgt.Cells(rownextTgt, "G").Resize(.Rows.Count, 1).Value2 = .Offset(0, 1).Resize(, 1).Value2
    End With
    
    Application.ScreenUpdating = False
    
End Sub

Breaking it up into 2 parts would be longer but might be clearer:
(you could put the 2nd "With" inside the first and just use With .Offset(0, 1).Resize(, 1) dropping the rngProductSrc but it is the same number of lines and probably less clear)

    With rngProductSrc
        shtTgt.Cells(rownextTgt, "D").Resize(.Rows.Count, .Columns.Count).Value2 = .Value2
    End With
    
    With rngProductSrc.Offset(0, 1).Resize(, 1)
        shtTgt.Cells(rownextTgt, "G").Resize(.Rows.Count, .Columns.Count).Value2 = .Value2
    End With