PDA

View Full Version : Copy and Paste data from multiple cells



andytpl
08-14-2007, 06:58 PM
I am not too sure if what I want to do possible with VBA.
In cell B14 I want to copy the data starting from cell B43 and downward. That is to say if cell B43, B44 contain data and if B45 is blank only B43 and B44 will be copied into cell B14 sequentially. It is like entering data in cell B14 and then press Alt Enter to allow entering data on another row for data from B44.
It will be wonderful if this can be done as I have more than 100 worksheets to go through for this repetitive action.

andytpl
08-14-2007, 08:06 PM
Guys,

I tried this codes and it works.

Const source = 43
Const dest = 14
Sub MyFill()
Dim i As Long, V As Variant
Range("B" & dest) = ""
For i = 0 To 65535 - source 'adjust if XL2007
V = CStr(Range("B" & source).Offset(i, 0))
If Len(V) < 1 Then Exit For
Range("B" & dest) = Range("B" & dest) & vbLf & V
Next
End Sub

mdmackillop
08-14-2007, 11:57 PM
Hi Andy,
Here's a couple of vatiations. The first has the same actions as your own code. The second will process all sheets in a workbook.
Option Explicit

Const source = 43
Const dest = 14

Sub MyFill2()
Dim i As Long, V As Variant
Dim c As Range, d As Range
Set c = Range("B" & dest)
Set d = Range("B" & source)
c.ClearContents
Do Until d.Offset(i) = ""
V = V & vbLf & d.Offset(i)
i = i + 1
Loop
If Len(V) > 0 Then
c = Right(V, Len(V) - 1)
End If
End Sub

Sub MyFill3()
Dim i As Long, V As Variant
Dim c As Range, d As Range
Dim sh As Worksheet

For Each sh In Worksheets
Set c = sh.Range("B" & dest)
Set d = sh.Range("B" & source)
V = ""
i = 0
c.ClearContents
Do Until d.Offset(i) = ""
V = V & vbLf & d.Offset(i)
i = i + 1
Loop
If Len(V) > 0 Then
c = Right(V, Len(V) - 1)
End If
Next
End Sub

andytpl
08-15-2007, 12:01 AM
mdmackkillop,

One question though, if in this workbooks only those sheets with name starting with INF will be affected by this codes and secondly if there are hidden sheets will your codes still work?

mdmackillop
08-15-2007, 12:10 AM
Amend the code as follows; remembering the End If . It should work on hidden sheets, but check for yourself.
For Each sh In Worksheets
If UCase(Left(sh.Name, 3)) = "INF" Then

andytpl
08-15-2007, 12:24 AM
While running the codes, I encountered this error, "Cannot change part of a merged cell".

mdmackillop
08-15-2007, 12:57 AM
Merged cells cause problems with code, and are best avoided. Use Centre Across Selection instead, where possible. If you can post your book, we can have a look at the problem.

andytpl
08-15-2007, 01:16 AM
I have uploaded the file.
pw : cmr9n8hn

mdmackillop
08-15-2007, 02:14 PM
Sub MyFill3()
Dim i As Long, V As Variant
Dim c As Range, d As Range
Dim sh As Worksheet

For Each sh In Worksheets
Set c = sh.Range("B" & dest).MergeArea
Set d = sh.Range("B" & source)
V = ""
i = 0
c.ClearContents
Do Until d.Offset(i) = ""
V = V & vbLf & d.Offset(i)
i = i + 1
Loop
If Len(V) > 0 Then
c = Right(V, Len(V) - 1)
End If
Next
End Sub


BTW, you should really get in the habit of always using Option Explicit, especially in complicated procedures such as this. There are certainly a few undeclared variables.

andytpl
08-15-2007, 05:40 PM
Thank you for the codes, they work as they ought to.
I note your advice and will bear that in mind as I learn more about VBA.