- Is there a shorter way to do this?
- Like in one click and the data goes to where I want it to be?
- Or maybe a shorter code for this?
Because the worksheet may vary but the details are all the same.. Please see the difference in transfersheet2 and 3...
Some cells may be blank in column C (referring to where I am copying from) but I want to copy it so that the details of each row won't be messed up. Can this be done? To copy even if it there is an empty cell?
Also, something's wrong with my second and third loop... The second one, when I click it once, it's ok but if by accident you click it again the data will duplicate.. Is there a way to stop this duplication from happening?
I tried using a message box but it's not working the way I want it to be.. I wanted the message box to appear only if I click it the second time... I think it's because of the offset I used... but I don't really know.
Sub TransferSheet1()
Dim i As Long
Dim LastRow As Long
Dim wb As Workbook
Dim sec As Worksheet
Dim sht1 As Worksheet
Set wb = ThisWorkbook
Set sec = wb.Sheets("SECOND")
Set sht1 = wb.Sheets("Sheet1")
'Find the last row (in column c) with data.
LastRow = sht1.Range("C:C").Find("*", searchdirection:=xlPrevious).row
ii = 2
'This is the beginning of the loop
For i = 6 To LastRow
'First activity
sec.Range("A" & ii) = sht1.Range("C" & i).Value
sec.Range("B" & ii) = sht1.Range("D" & i).Value
sec.Range("C" & ii) = sht1.Range("F" & i).Value
sec.Range("D" & ii) = sht1.Range("G" & i).Value
ii = ii + 1
Next i
End Sub
Private Sub GetValuesFromSheet2()
Dim i As Long
Dim ii As Long
Dim LastRow As Long
Dim wb As Workbook
Dim sec As Worksheet
Dim sht2 As Worksheet
Set wb = ThisWorkbook
Set sec = wb.Sheets("SECOND")
Set sht2 = wb.Sheets("Sheet2")
'Find the last row (in column c) with data.
LastRow = sht2.Range("C:C").Find("*", searchdirection:=xlPrevious).row
ii = 1
'This is the beginning of the loop
For i = 6 To LastRow
'First activity
sec.Range("A" & Rows.count).End(xlUp).Offset(1) = sht2.Range("C" & i).Value
sec.Range("B" & Rows.count).End(xlUp).Offset(1) = sht2.Range("D" & i).Value
sec.Range("C" & Rows.count).End(xlUp).Offset(1) = sht2.Range("F" & i).Value
sec.Range("D" & Rows.count).End(xlUp).Offset(ii, 1) = sht2.Range("G" & i).Value
ii = ii + 1
Next i
With Application
.EnableEvents = True
.DisplayAlerts = True
End With
MsgBox "Content Already copied"
End Sub
Private Sub CmdTransferSheet3_Click()
Dim i As Long
Dim ii As Long
Dim LastRow As Long
Dim wb As Workbook
Dim sec As Worksheet
Dim sht2 As Worksheet
Set wb = ThisWorkbook
Set sec = wb.Sheets("SECOND")
Set sht2 = wb.Sheets("Sheet3")
'Find the last row (in column c) with data.
LastRow = sht2.Range("C:C").Find("*", searchdirection:=xlPrevious).row
ii = 1
'This is the beginning of the loop
For i = 6 To LastRow
'First activity
sec.Range("A" & Rows.count).End(xlUp).Offset(1) = sht2.Range("C" & i).Value
sec.Range("B" & Rows.count).End(xlUp).Offset(1) = sht2.Range("D" & i).Value
sec.Range("C" & Rows.count).End(xlUp).Offset(1) = sht2.Range("F" & i).Value
sec.Range("E" & Rows.count).End(xlUp).Offset(ii,1) = sht2.Range("G" & i).Value
ii = ii + 1
Next i
End Sub
