Forum Discussion
VBA code to count, copy, paste, last row, if
Try this macro:
Sub CopyData() Dim wsh1 As Worksheet Dim wsh2 As Worksheet Dim r1 As Long, r2 As Long Dim m1 As Long, m2 As Long, m3 As Long, n As Long Application.ScreenUpdating = False Set wsh1 = Worksheets("Sheet1") Set wsh2 = Worksheets("Sheet2") m1 = wsh1.Range("A" & wsh1.Rows.Count).End(xlUp).Row m2 = wsh1.Range("B" & wsh1.Rows.Count).End(xlUp).Row m3 = wsh1.Range("C" & wsh1.Rows.Count).End(xlUp).Row n = wsh2.Range("A" & wsh2.Rows.Count).End(xlUp).Row + 1 For r1 = 2 To m1 For r2 = 2 To m2 wsh2.Range("A" & n).Resize(m3 - 1).Value = wsh1.Range("A" & r1).Value wsh2.Range("B" & n).Resize(m3 - 1).Value = wsh1.Range("B" & r2).Value wsh2.Range("C" & n).Resize(m3 - 1, 3).Value = wsh1.Range("C2:E" & m3).Value n = n + m3 - 1 Next r2 Next r1 Application.ScreenUpdating = True End Sub
Try this macro:
Sub CopyData()
Dim wsh1 As Worksheet
Dim wsh2 As Worksheet
Dim r1 As Long, r2 As Long
Dim m1 As Long, m2 As Long, m3 As Long, n As Long
Application.ScreenUpdating = False
Set wsh1 = Worksheets("Sheet1")
Set wsh2 = Worksheets("Sheet2")
m1 = wsh1.Range("A" & wsh1.Rows.Count).End(xlUp).Row
m2 = wsh1.Range("B" & wsh1.Rows.Count).End(xlUp).Row
m3 = wsh1.Range("C" & wsh1.Rows.Count).End(xlUp).Row
n = wsh2.Range("A" & wsh2.Rows.Count).End(xlUp).Row + 1
For r1 = 2 To m1
For r2 = 2 To m2
wsh2.Range("A" & n).Resize(m3 - 1).Value = wsh1.Range("A" & r1).Value
wsh2.Range("B" & n).Resize(m3 - 1).Value = wsh1.Range("B" & r2).Value
wsh2.Range("C" & n).Resize(m3 - 1, 3).Value = wsh1.Range("C2:E" & m3).Value
n = n + m3 - 1
Next r2
Next r1
Application.ScreenUpdating = True
End Sub
HansVogelaar Thank you very much for the quick reply and the help. It works exactly as I hoped.
Would you please help me to modify it so that it:
1. Counts only in a set range in sheet 1 i.e A8:A18
2. Copy the data in wsh1 A2, B2, A4, B4 to wsh2 column G,H,I,J
3. IF wsh1 column G is in g : value in wsh1 column F/1000 and paste in wsh2 column F.
4. IF wsh1 column G is in kg : Copy value in wsh1 column F and paste in wsh2 column F.
Thank you
Here is a new version.
Sub CopyData() Dim wsh1 As Worksheet Dim wsh2 As Worksheet Dim r1 As Long, r2 As Long Dim m1 As Long, m2 As Long, m3 As Long, n As Long Application.ScreenUpdating = False Set wsh1 = Worksheets("Sheet1") Set wsh2 = Worksheets("Sheet2") m1 = wsh1.Range("A19").End(xlUp).Row m2 = wsh1.Range("B19").End(xlUp).Row m3 = wsh1.Range("C19").End(xlUp).Row - 7 n = wsh2.Range("A" & wsh2.Rows.Count).End(xlUp).Row + 1 For r1 = 8 To m1 For r2 = 8 To m2 wsh2.Range("A" & n).Resize(m3).Value = wsh1.Range("A" & r1).Value wsh2.Range("B" & n).Resize(m3).Value = wsh1.Range("B" & r2).Value wsh2.Range("C" & n).Resize(m3, 3).Value = wsh1.Range("C8:E" & m3 + 7).Value With wsh2.Range("F" & n).Resize(m3) .Formula = "=Sheet1!F8/IF(Sheet1!G8=""g"",1000,1)" .Value = .Value End With wsh2.Range("G" & n).Resize(m3, 2).Value = wsh1.Range("A2:B2").Value wsh2.Range("I" & n).Resize(m3, 2).Value = wsh1.Range("A4:B4").Value n = n + m3 Next r2 Next r1 Application.ScreenUpdating = True End SubGood Afternoon Hans
Thank you very much for all the help. The previous codes all did exactly what I asked. I did however simplify the question (for privacy reasons) with the hope of modifying it to the model where I need it, but I am stuck. I am attaching another workbook with the exact layout that I am working on. Would you please help me again?
Set wsh1 = Worksheets("Spray instruction PL")
Set wsh2 = Worksheets("Records.")
- Count the amount of cells used in wsh1 F16:F25
- Copy the counted (in step 1) amount of cells in wsh 1 and paste in in last row +1 wsh2:
Copy wsh1 column:
Paste wsh2 column:
F
D
G
E
H
F
"='Spray instruction PL'!L16*IF(OR('Spray instruction PL'!N16=""KG"",'Spray instruction PL'!N16=""L""),1000,1)/10"
G
O
I
R
L
T
O
U
A
- Also copy and paste the value of the following cells in wsh2
Copy wsh1 cells:
Paste wsh2 column:
$M$11
M
"=TEXTJOIN("" ,"",TRUE,K8,K7,K6)"
N
"=TEXTJOIN("" ,"",TRUE,G8,G7,G6)"
Q
$F$5
V
$O$8
X
$P$8
Y
- The data in step 2 and 3 should be repeated for every used cell found in wsh1 B16:B25
Columns in wsh1 with cells that needs to repeat with every counted row:
Paste wsh2 column:
B16:B25
B
C16:C25
C
D16:D25
W
E16:E25
U
I look forward to your answer.
Kind regards
Hi Kettie,
I think this will do it, but please test thoroughly:
Sub CopyToRecords() Dim wsh1 As Worksheet Dim wsh2 As Worksheet Dim r1 As Long, r2 As Long Dim m1 As Long, m2 As Long, n As Long Application.ScreenUpdating = False Set wsh1 = Worksheets("Spray instruction PL") Set wsh2 = Worksheets("Records.") m1 = wsh1.Range("B26").End(xlUp).Row m2 = wsh1.Range("F26").End(xlUp).Row - 15 n = wsh2.Range("A" & wsh2.Rows.Count).End(xlUp).Row + 1 For r1 = 16 To m1 For r2 = 16 To m2 + 15 ' Based on column B wsh2.Range("B" & n).Resize(m2).Value = wsh1.Range("B" & r1).Value wsh2.Range("C" & n).Resize(m2).Value = wsh1.Range("C" & r1).Value wsh2.Range("W" & n).Resize(m2).Value = wsh1.Range("D" & r1).Value wsh2.Range("U" & n).Resize(m2).Value = wsh1.Range("E" & r1).Value ' Based on coluumn F wsh2.Range("D" & n).Resize(m2).Value = wsh1.Range("F" & r2).Value wsh2.Range("E" & n).Resize(m2).Value = wsh1.Range("G" & r2).Value wsh2.Range("F" & n).Resize(m2).Value = wsh1.Range("H" & r2).Value With wsh2.Range("G" & n).Resize(m2) .Formula = "='Spray instruction PL'!L16*" & _ "IF(OR('Spray instruction PL'!N16={""KG"",""L""}),1000,1)" .Value = .Value End With wsh2.Range("I" & n).Resize(m2).Value = wsh1.Range("O" & r2).Value wsh2.Range("L" & n).Resize(m2).Value = wsh1.Range("R" & r2).Value wsh2.Range("O" & n).Resize(m2).Value = wsh1.Range("T" & r2).Value wsh2.Range("A" & n).Resize(m2).Value = wsh1.Range("U" & r2).Value ' Based on fixed cells wsh2.Range("M" & n).Resize(m2).Value = wsh1.Range("M11").Value With wsh2.Range("N" & n).Resize(m2) .Formula = "=TEXTJOIN("","",TRUE,'Spray instruction PL'!$K$8," & _ "'Spray instruction PL'!$K$7,'Spray instruction PL'!$K$6)" .Value = .Value End With With wsh2.Range("Q" & n).Resize(m2) .Formula = "=TEXTJOIN("","",TRUE,'Spray instruction PL'!$G$8," & _ "'Spray instruction PL'!$G$7,'Spray instruction PL'!$G$6)" .Value = .Value End With wsh2.Range("V" & n).Resize(m2).Value = wsh1.Range("F5").Value wsh2.Range("X" & n).Resize(m2).Value = wsh1.Range("O8").Value wsh2.Range("Y" & n).Resize(m2).Value = wsh1.Range("P8").Value n = n + m2 Next r2 Next r1 Application.ScreenUpdating = True End Sub
