Menu
Yes, I have written this Macro for Microsoft Excel (2010 if that helps), with the assistance of someone else. I am wondering if anyone has a way of shortening it, and making it more efficient. However still getting the same outcome it gave before? An example of the CSV format I have to work with can be found here... And yes, unfortunately, they do have to be put into those columns and cells..
The only issue I am really stumped on is this:
on .Cell(2, 3) for example... If you notice, on each section it would copy and paste, it has a new row.. I want it to do that.. I am novice at this, and could not find a way to make it just paste each one to the next available row.. So my solution for this was to do 2, 3, 4, 5.. And so on.. If anyone knows how to change this as well to make this.. Loop? Per say, that would be great help. Just loop for the amount of data that is being copied though, and not repeat.
Here is an example CSV: Media Fire It's Clean, I promise. Thank you for your time.
Macro Code to copy certain Column/Row data Cells from one sheet to another to specific Cells
Sub FormatData()
Dim col As Integer
For col = 1 To 1
With Worksheets(2)
.Cells(2, 2) = Cells(1, col)
.Cells(2, 3) = Cells(2, col) & ". " & Cells(3, col) & ". " & Cells(4, col) & ". " & Cells(5, col) & "."
.Cells(2, 4) = Cells(7, col)
.Cells(2, 5) = Cells(10, col)
End With
Next col
For col = 2 To 2
With Worksheets(2)
.Cells(3, 2) = Cells(1, col)
.Cells(3, 3) = Cells(2, col) & ". " & Cells(3, col) & ". " & Cells(4, col) & ". " & Cells(5, col) & "."
.Cells(3, 4) = Cells(7, col)
.Cells(3, 5) = Cells(10, col)
End With
Next col
For col = 3 To 3
With Worksheets(2)
.Cells(4, 2) = Cells(1, col)
.Cells(4, 3) = Cells(2, col) & ". " & Cells(3, col) & ". " & Cells(4, col) & ". " & Cells(5, col) & "."
.Cells(4, 4) = Cells(7, col)
.Cells(4, 5) = Cells(10, col)
End With
Next col
For col = 4 To 4
With Worksheets(2)
.Cells(5, 2) = Cells(1, col)
.Cells(5, 3) = Cells(2, col) & ". " & Cells(3, col) & ". " & Cells(4, col) & ". " & Cells(5, col) & "."
.Cells(5, 4) = Cells(7, col)
.Cells(5, 5) = Cells(10, col)
End With
Next col
For col = 1 To 1
With Worksheets(2)
.Cells(6, 2) = Cells(13, col)
.Cells(6, 3) = Cells(14, col) & ". " & Cells(15, col) & ". " & Cells(16, col) & ". " & Cells(17, col) & "."
.Cells(6, 4) = Cells(19, col)
.Cells(6, 5) = Cells(22, col)
End With
Next col
For col = 2 To 2
With Worksheets(2)
.Cells(7, 2) = Cells(13, col)
.Cells(7, 3) = Cells(14, col) & ". " & Cells(15, col) & ". " & Cells(16, col) & ". " & Cells(17, col) & "."
.Cells(7, 4) = Cells(19, col)
.Cells(7, 5) = Cells(22, col)
End With
Next col
For col = 3 To 3
With Worksheets(2)
.Cells(8, 2) = Cells(13, col)
.Cells(8, 3) = Cells(14, col) & ". " & Cells(15, col) & ". " & Cells(16, col) & ". " & Cells(17, col) & "."
.Cells(8, 4) = Cells(19, col)
.Cells(8, 5) = Cells(22, col)
End With
Next col
For col = 4 To 4
With Worksheets(2)
.Cells(9, 2) = Cells(13, col)
.Cells(9, 3) = Cells(14, col) & ". " & Cells(15, col) & ". " & Cells(16, col) & ". " & Cells(17, col) & "."
.Cells(9, 4) = Cells(19, col)
.Cells(9, 5) = Cells(22, col)
End With
Next col
For col = 1 To 1
With Worksheets(2)
.Cells(10, 2) = Cells(25, col)
.Cells(10, 3) = Cells(26, col) & ". " & Cells(27, col) & ". " & Cells(28, col) & ". " & Cells(29, col) & "."
.Cells(10, 4) = Cells(31, col)
.Cells(10, 5) = Cells(34, col)
End With
Next col
For col = 2 To 2
With Worksheets(2)
.Cells(11, 2) = Cells(25, col)
.Cells(11, 3) = Cells(26, col) & ". " & Cells(27, col) & ". " & Cells(28, col) & ". " & Cells(29, col) & "."
.Cells(11, 4) = Cells(31, col)
.Cells(11, 5) = Cells(34, col)
End With
Next col
For col = 3 To 3
With Worksheets(2)
.Cells(12, 2) = Cells(25, col)
.Cells(12, 3) = Cells(26, col) & ". " & Cells(27, col) & ". " & Cells(28, col) & ". " & Cells(29, col) & "."
.Cells(12, 4) = Cells(31, col)
.Cells(12, 5) = Cells(34, col)
End With
Next col
For col = 4 To 4
With Worksheets(2)
.Cells(13, 2) = Cells(25, col)
.Cells(13, 3) = Cells(26, col) & ". " & Cells(27, col) & ". " & Cells(28, col) & ". " & Cells(29, col) & "."
.Cells(13, 4) = Cells(31, col)
.Cells(13, 5) = Cells(34, col)
End With
Next col
For col = 1 To 1
With Worksheets(2)
.Cells(14, 2) = Cells(37, col)
.Cells(14, 3) = Cells(38, col) & ". " & Cells(39, col) & ". " & Cells(40, col) & ". " & Cells(41, col) & "."
.Cells(14, 4) = Cells(43, col)
.Cells(14, 5) = Cells(46, col)
End With
Next col
For col = 2 To 2
With Worksheets(2)
.Cells(15, 2) = Cells(37, col)
.Cells(15, 3) = Cells(38, col) & ". " & Cells(39, col) & ". " & Cells(40, col) & ". " & Cells(41, col) & "."
.Cells(15, 4) = Cells(43, col)
.Cells(15, 5) = Cells(46, col)
End With
Next col
For col = 3 To 3
With Worksheets(2)
.Cells(16, 2) = Cells(37, col)
.Cells(16, 3) = Cells(38, col) & ". " & Cells(39, col) & ". " & Cells(40, col) & ". " & Cells(41, col) & "."
.Cells(16, 4) = Cells(43, col)
.Cells(16, 5) = Cells(46, col)
End With
Next col
For col = 4 To 4
With Worksheets(2)
.Cells(17, 2) = Cells(37, col)
.Cells(17, 3) = Cells(38, col) & ". " & Cells(39, col) & ". " & Cells(40, col) & ". " & Cells(41, col) & "."
.Cells(17, 4) = Cells(43, col)
.Cells(17, 5) = Cells(46, col)
End With
Next col
For col = 1 To 1
With Worksheets(2)
.Cells(18, 2) = Cells(49, col)
.Cells(18, 3) = Cells(50, col) & ". " & Cells(51, col) & ". " & Cells(52, col) & ". " & Cells(53, col) & "."
.Cells(18, 4) = Cells(55, col)
.Cells(18, 5) = Cells(58, col)
End With
Next col
For col = 2 To 2
With Worksheets(2)
.Cells(19, 2) = Cells(49, col)
.Cells(19, 3) = Cells(50, col) & ". " & Cells(51, col) & ". " & Cells(52, col) & ". " & Cells(53, col) & "."
.Cells(19, 4) = Cells(55, col)
.Cells(19, 5) = Cells(58, col)
End With
Next col
For col = 3 To 3
With Worksheets(2)
.Cells(20, 2) = Cells(49, col)
.Cells(20, 3) = Cells(50, col) & ". " & Cells(51, col) & ". " & Cells(52, col) & ". " & Cells(53, col) & "."
.Cells(20, 4) = Cells(55, col)
.Cells(20, 5) = Cells(58, col)
End With
Next col
For col = 4 To 4
With Worksheets(2)
.Cells(21, 2) = Cells(49, col)
.Cells(21, 3) = Cells(50, col) & ". " & Cells(51, col) & ". " & Cells(52, col) & ". " & Cells(53, col) & "."
.Cells(21, 4) = Cells(55, col)
.Cells(21, 5) = Cells(58, col)
End With
Next col
For col = 1 To 1
With Worksheets(2)
.Cells(22, 2) = Cells(61, col)
.Cells(22, 3) = Cells(62, col) & ". " & Cells(63, col) & ". " & Cells(64, col) & ". " & Cells(65, col) & "."
.Cells(22, 4) = Cells(67, col)
.Cells(22, 5) = Cells(70, col)
End With
Next col
For col = 2 To 2
With Worksheets(2)
.Cells(23, 2) = Cells(61, col)
.Cells(23, 3) = Cells(62, col) & ". " & Cells(63, col) & ". " & Cells(64, col) & ". " & Cells(65, col) & "."
.Cells(23, 4) = Cells(67, col)
.Cells(23, 5) = Cells(70, col)
End With
Next col
For col = 3 To 3
With Worksheets(2)
.Cells(24, 2) = Cells(61, col)
.Cells(24, 3) = Cells(62, col) & ". " & Cells(63, col) & ". " & Cells(64, col) & ". " & Cells(65, col) & "."
.Cells(24, 4) = Cells(67, col)
.Cells(24, 5) = Cells(70, col)
End With
Next col
For col = 4 To 4
With Worksheets(2)
.Cells(25, 2) = Cells(61, col)
.Cells(25, 3) = Cells(62, col) & ". " & Cells(63, col) & ". " & Cells(64, col) & ". " & Cells(65, col) & "."
.Cells(25, 4) = Cells(67, col)
.Cells(25, 5) = Cells(70, col)
End With
Next col
For col = 1 To 1
With Worksheets(2)
.Cells(26, 2) = Cells(73, col)
.Cells(26, 3) = Cells(74, col) & ". " & Cells(75, col) & ". " & Cells(76, col) & ". " & Cells(77, col) & "."
.Cells(26, 4) = Cells(79, col)
.Cells(26, 5) = Cells(82, col)
End With
Next col
For col = 2 To 2
With Worksheets(2)
.Cells(27, 2) = Cells(73, col)
.Cells(27, 3) = Cells(74, col) & ". " & Cells(75, col) & ". " & Cells(76, col) & ". " & Cells(77, col) & "."
.Cells(27, 4) = Cells(79, col)
.Cells(27, 5) = Cells(82, col)
End With
Next col
For col = 3 To 3
With Worksheets(2)
.Cells(28, 2) = Cells(73, col)
.Cells(28, 3) = Cells(74, col) & ". " & Cells(75, col) & ". " & Cells(76, col) & ". " & Cells(77, col) & "."
.Cells(28, 4) = Cells(79, col)
.Cells(28, 5) = Cells(82, col)
End With
Next col
For col = 4 To 4
With Worksheets(2)
.Cells(29, 2) = Cells(73, col)
.Cells(29, 3) = Cells(74, col) & ". " & Cells(75, col) & ". " & Cells(76, col) & ". " & Cells(77, col) & "."
.Cells(29, 4) = Cells(79, col)
.Cells(29, 5) = Cells(82, col)
End With
Next col
For col = 1 To 1
With Worksheets(2)
.Cells(30, 2) = Cells(85, col)
.Cells(30, 3) = Cells(86, col) & ". " & Cells(87, col) & ". " & Cells(88, col) & ". " & Cells(89, col) & "."
.Cells(30, 4) = Cells(91, col)
.Cells(30, 5) = Cells(94, col)
End With
Next col
For col = 2 To 2
With Worksheets(2)
.Cells(31, 2) = Cells(85, col)
.Cells(31, 3) = Cells(86, col) & ". " & Cells(87, col) & ". " & Cells(88, col) & ". " & Cells(89, col) & "."
.Cells(31, 4) = Cells(91, col)
.Cells(31, 5) = Cells(94, col)
End With
Next col
For col = 3 To 3
With Worksheets(2)
.Cells(32, 2) = Cells(85, col)
.Cells(32, 3) = Cells(86, col) & ". " & Cells(87, col) & ". " & Cells(88, col) & ". " & Cells(89, col) & "."
.Cells(32, 4) = Cells(91, col)
.Cells(32, 5) = Cells(94, col)
End With
Next col
For col = 4 To 4
With Worksheets(2)
.Cells(33, 2) = Cells(85, col)
.Cells(33, 3) = Cells(86, col) & ". " & Cells(87, col) & ". " & Cells(88, col) & ". " & Cells(89, col) & "."
.Cells(33, 4) = Cells(91, col)
.Cells(33, 5) = Cells(94, col)
End With
Next col
End Sub
828
Here's a refactored Sub
Points to note:
use variant arrays for the looping/data processing because looping through cells is slow
you can change the value of srcBlocks to control how many blocks to process, or extract it from your source data
refering to the destination sheet by index can be problematic if it is moved. Safer to refer to it by name Worksheets("SheetName")
.
Sub FormatData()
Dim rw2 As Integer, rwA As Integer, colA As Integer
Dim vDst() As Variant, vSrc As Variant
Dim srcBlocks As Integer
srcBlocks = 8 ' process 8 blocks of 12 rows
vSrc = ActiveSheet.Range("A1:D" & srcBlocks * 12)
ReDim vDst(1 To srcBlocks * 4 + 1, 1 To 5)
For rwA = 0 To srcBlocks * 12 - 1 Step 12 ' = 0, 12, 24, ...
For colA = 1 To 4 ' 4 columns in Src
rw2 = (rwA \ 12) * 4 + colA + 1 ' 4 Dst rws per block, = 2..5, 6..9, ...
vDst(rw2, 2) = vSrc(rwA + 1, colA)
vDst(rw2, 3) = vSrc(rwA + 2, colA) & ". " & _
vSrc(rwA + 3, colA) & ". " & _
vSrc(rwA + 4, colA) & ". " & _
vSrc(rwA + 5, colA) & "."
vDst(rw2, 4) = vSrc(rwA + 7, colA)
vDst(rw2, 5) = vSrc(rwA + 10, colA)
Next colA
Next rwA
Worksheets(2).Range("A1:E" & CStr(srcBlocks * 4 + 1)) = vDst
End Sub
To add flexability, for variable number of columns in Source data
Sub FormatData()
Dim rw2 As Integer, rwA As Integer, colA As Integer
Dim vDst() As Variant, vSrc As Variant
Dim srcBlocks As Integer, srcColumns As Integer
srcBlocks = 8 ' process 8 blocks of 12 rows '
srcColumns = 5 ' Columns in source data '
vSrc = ActiveSheet.Range( _
ActiveSheet.Cells(1, 1), _
ActiveSheet.Cells(srcBlocks * 12, srcColumns))
ReDim vDst(1 To srcBlocks * srcColumns + 1, 1 To 5)
For rwA = 0 To srcBlocks * 12 - 1 Step 12 ' = 0, 12, 24, ... '
For colA = 1 To srcColumns ' srcColumns columns in Source '
rw2 = (rwA \ 12) * srcColumns + colA + 1 ' srcColumns rows in Destination per Source block '
vDst(rw2, 2) = vSrc(rwA + 1, colA)
vDst(rw2, 3) = vSrc(rwA + 2, colA) & ". " & _
vSrc(rwA + 3, colA) & ". " & _
vSrc(rwA + 4, colA) & ". " & _
vSrc(rwA + 5, colA) & "."
vDst(rw2, 4) = vSrc(rwA + 7, colA)
vDst(rw2, 5) = vSrc(rwA + 10, colA)
Next colA
Next rwA
Worksheets(2).Range("A1:E" & CStr(srcBlocks * 4 + 1)) = vDst
End Sub
Here's a pretty compact way of doing it, note that the slash in the rindex formula is a backslash:
Sub FormatData()
Dim rw As Integer
Dim rindex As Integer
With Worksheets(2)
For rw = 2 To 33
rindex = (rw - 2) \ 4
.Cells(rw, 2) = Cells(12 * rindex + 1, (rw - 1) - 4 * rindex)
.Cells(rw, 3) = Cells(12 * rindex + 2, (rw - 1) - 4 * rindex) & "." & _
Cells(12 * rindex + 3, (rw - 1) - 4 * rindex) & "." & _
Cells(12 * rindex + 4, (rw - 1) - 4 * rindex) & "." & _
Cells(12 * rindex + 5, (rw - 1) - 4 * rindex) & "."
.Cells(rw, 4) = Cells(12 * rindex + 7, (rw - 1) - 4 * rindex)
.Cells(rw, 5) = Cells(12 * rindex + 10, (rw - 1) - 4 * rindex)
Next rw
End With
End Sub
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With
