I have up to 6 cells with potential data coming from 6 different places. I am trying to get only the first three cells with data transferred to another sheet
Private Sub Transfer_Data()
Sheets("sheet1").Range("A1:A6").SpecialCells(xlCellTypeConstants, 23).copy
Sheets("sheet2").Range("A1:A3").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
This is what i have i know i am missing allot
This is how I would do it:
Sub Transfer_Data()
Dim i As Long, j As Long
j = 1
For i = 1 To 6
If Sheets("Sheet1").Cells(i, 1).Value <> "" Then
Sheets("Sheet2").Cells(j, 1).Value = Sheets("Sheet1").Cells(i, 1).Value
j = j + 1
End If
If j > 3 Then Exit For
Next i
End Sub
EDITED:
Sub Transfer_Data()
Dim i As Long, j As Long
j = 3
For i = 1 To 6
If Sheets("Sheet1").Cells(i, 1).Value <> "" Then
Sheets("Sheet2").Cells(j, 1).Value = Sheets("Sheet1").Cells(i, 1).Value
j = j - 1
End If
If j = 0 Then Exit For
Next i
End Sub
Untested, there may be another, more elegant way of doing this:
Private Sub TransferData()
Dim cellCount as long
Dim cell as range
Dim rangeToCopy as range
For each cell in Sheets("sheet1").Range("A1:A6").SpecialCells(xlCellTypeConstants) ' 23 is unnecessary, as you get all XlSpecialCellsValue constants by default
' See https://docs.microsoft.com/en-us/office/vba/api/excel.range.specialcells
cellCount = cellCount + cell.cells.count
If not (rangeToCopy is nothing) then
Set rangeToCopy = application.union(rangeToCopy, cell)
Else
Set rangeToCopy = cell
End if
If cellCount = 3 then exit for
Next cell
If not (rangeToCopy is nothing) then
rangeToCopy.copy
Sheets("sheet2").Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End if
End Sub
I know this already answered, but how about a crazy one-liner?
Sub TransferData()
ThisWorkbook.Sheets("Sheet2").Range("A1:A3").Value2 = WorksheetFunction.Transpose(Split(Replace$(Join(WorksheetFunction.Transpose(ThisWorkbook.Sheets("Sheet1").Range("A1:A6").Value2), ","), ",,", ","), ","))
End Sub