Macro to put data below data in a and b from columns c and d

[EmmieLou]

Need Help! Have my macro putting first row of column C data in column A, but
need the rest of the column to go in as well. Also need to put the data from
column D into column B ( C and D are a set that is of the same data type as a
nd b respectively)
Here is what I have so far.... fairly new to vba, but learning fast.
Thanks!!!
Sub Find_Blank()
Dim BCell, NBCell

Range("A1").Select
Range("B1").Select
For i = 1 To 65536
If ActiveCell.Value = Empty Then 'First empty cell found; put in col
c's stuff:
BCell = "A" & CStr(i)
Range("A" & CStr(i)).Select
CCell = "B" & CStr(i)
Range("B" & CStr(i)).Select
For Each C In Worksheets("Sheet1").Range("C1:C100").Cells
If C.Value <> "" Then
Range("A" & CStr(i)).Select
Range("A" & CStr(i)).Value = C.Value
Range("B" & CStr(i)).Select
Range("B" & CStr(i)).Value = D.Value
i = i + 1
Else 'Blank cell in col B found; get column stuff:
'**
For Each D In Worksheets("Sheet1").Range("D1100").Cells
If D.Value <> "" Then
Range("A" & CStr(i)).Select
Range("A" & CStr(i)).Value = D.Value
i = i + 1
End If
Next D
Exit Sub
'**
End If
Next C
Exit Sub
Else
Range("A" & CStr(i + 1)).Select
End If
Next i
End Sub

 

[Barb Reinhardt]

Try this. I'd save your workbook though (JUST IN CASE)

Sub CopyMultipleColumns()

'Copy D to B
Call CopyColumns(4, 2) 'Column D = 4, COlumn B = 2

'Copy C to A
Call CopyColumns(3, 1) 'Column C = 3, Column A = 1
End Sub
Sub CopyColumns(CopyFromColumn As Long, CopyToColumn As Long)
Dim lRow As Long
Dim myRange As Range
Dim aWS As Worksheet

Set aWS = ActiveSheet
Set myRange = aWS.Cells(1, CopyFromColumn)
lRow = aWS.Cells(aWS.Rows.Count, myRange.Column).End(xlUp).Row
Set myRange = myRange.Resize(lRow, 1)
myRange.Offset(0, CopyToColumn - CopyFromColumn).Value2 = myRange.Value2

End Sub

 

[EmmieLou]

Thanks Barb!
That is very close. The only problem now is that it pastes over the
existing data in columns a and b. I need it to paste at the end of the
existing data in columns a and b. I re-vamped my original macro and now it
almost works too, except it is placing column c into columns a and b, and
places coulmn d data below the dupe in column b....

Sub Find_Blank_Version2()
Dim BCell, NBCell

Range("A1").Select
Range("B1").Select
For i = 1 To 65536
If ActiveCell.Value = Empty Then 'First empty cell found; put in col
c's stuff:
BCell = "A" & CStr(i)
Range("A" & CStr(i)).Select
CCell = "B" & CStr(i)
Range("B" & CStr(i)).Select
For Each C In Worksheets("Sheet1").Range("C1:C100").Cells
If C.Value <> "" Then
Range("A" & CStr(i)).Select
Range("A" & CStr(i)).Value = C.Value
Range("B" & CStr(i)).Select
Range("B" & CStr(i)).Value = C.Value
i = i + 1
Else 'Blank cell in col B found; get column stuff:
'**
For Each D In Worksheets("Sheet1").Range("D1100").Cells
If D.Value <> "" Then
Range("B" & CStr(i)).Select
Range("B" & CStr(i)).Value = D.Value
i = i + 1
End If
Next D
Exit Sub
'**
End If
Next C
Exit Sub
Else
Range("A" & CStr(i + 1)).Select
End If
Next i
End Sub
Thanks again, any additional help is greatly appreciated
EL

 

[Barb Reinhardt]

Replace this sub

Sub CopyColumns(CopyFromColumn As Long, CopyToColumn As Long)
Dim lRow As Long
Dim myRange As Range
Dim aWS As Worksheet

Set aWS = ActiveSheet
Set myRange = aWS.Cells(1, CopyFromColumn)
lRow = aWS.Cells(aWS.Rows.Count, myRange.Column).End(xlUp).Row
Set myRange = myRange.Resize(lRow, 1)
lRow = aWS.Cells(aWS.Rows.Count, CopyToColumn).End(xlUp).Row
myRange.Offset(lRow, CopyToColumn - CopyFromColumn).Value2 = myRange.Value2

End Sub

 

[EmmieLou]

Thanks Barb!!
That did the trick. Best wishes, and most appreciative.
EL