Rearranging data
Solved/Closed
liwate
Posts
1
Registration date
Tuesday September 8, 2020
Status
Member
Last seen
September 8, 2020
-
Updated on Sep 8, 2020 at 11:58 AM
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Contributor Last seen December 27, 2022 - Sep 10, 2020 at 11:44 AM
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Contributor Last seen December 27, 2022 - Sep 10, 2020 at 11:44 AM
Related:
- Rearranging data
- Tmobile data check - Guide
- Data transmission cable - Guide
- Download facebook data - Guide
- Transfer data from one excel worksheet to another automatically - Guide
- Spectrum mobile data usage - Guide
1 response
TrowaD
Posts
2921
Registration date
Sunday September 12, 2010
Status
Contributor
Last seen
December 27, 2022
555
Sep 10, 2020 at 11:44 AM
Sep 10, 2020 at 11:44 AM
Hi Iwate,
Give the following code a try and see how you like the result:
Best regards,
Trowa
Give the following code a try and see how you like the result:
Sub RunMe()
Dim sSheet, dSheet As Worksheet
Dim x, lRow, mV1, mV2 As Integer
Set sSheet = Sheets("Source")
Set dSheet = Sheets("Destination")
x = 66
dSheet.Select
lRow = Range("A" & Rows.Count).End(xlUp).Row + 1
Do
Range(Cells(lRow, "B"), Cells(lRow + 2, "B")).Value = Left(sSheet.Range("A" & x), 8)
Range(Cells(lRow, "C"), Cells(lRow + 2, "C")).Value = Right(sSheet.Range("A" & x), Len(sSheet.Range("A" & x)) - 8)
Range(Cells(lRow, "A"), Cells(lRow + 2, "A")).Value = sSheet.Range("C" & x)
Range("D" & lRow).Value = sSheet.Range("A" & x + 2).Value
If sSheet.Range("B" & x + 2).Value = vbNullString Then
mV1 = sSheet.Range("C" & x + 2).Value
Range("E" & lRow).Value = "(" & mV1 & ")"
Else
mV2 = sSheet.Range("B" & x + 2).Value
Range("E" & lRow).Value = mV2
End If
Range("D" & lRow + 1).Value = sSheet.Range("A" & x + 3).Value
If sSheet.Range("B" & x + 3).Value = vbNullString Then
mV1 = sSheet.Range("C" & x + 3).Value
Range("E" & lRow + 1).Value = "(" & mV1 & ")"
Else
mV2 = sSheet.Range("B" & x + 3).Value
Range("E" & lRow + 1).Value = mV2
End If
Range("E" & lRow + 2).Value = mV2 - mV1
x = x + 8
lRow = lRow + 3
Loop Until sSheet.Range("A" & x).Value = vbNullString
End Sub
Best regards,
Trowa