Automating copy-pasting of data values into a new spreadsheet layo

[Guest]

Ok, here's the deal:
I have two spreadsheets. One is the "master" spreadsheet that needs to be
updated, while the second spreadsheet is a basic report that contains all the
most up-to-date data. I need to import the second spreadsheet's data into the
master, but the problem is that the two have different formats.

The second spreadsheet contains data organized into four columns (Column A,
B, C, and D):
A1 B1 C1 D1
A2 B2 C2 D2
A3 B3 C3 D3

However, in order to copy-paste the data straight into the master
spreadsheet, I need all the data in the second spreadsheet in a SINGLE
column. I need to convert the format specified above and put all the data
into the Column A, in the following sequence:
A1
B1
C1
D1
A2
B2
C2
D2
A3
B3
C3
D3

And so on and so forth for about 5,000 lines.

Can anyone help me with the coding for this?

 

[Guest]

Hi,

It is easier just to import the data into the master with the following macro.

Change the constants as required make sure the data sheet is the active
window andrun it.

The macro needs to be saved in the master workbook.
'----start
Option Explicit

Sub importdata()

' change the items as needed
Const szMasterSheetName _
As String = "master" 'master sheet name
Const szMaster1stCell _
As String = "A1" 'first table cell in the master
Const lColumn As Long = "1" 'column in master to import to

Dim wsData As Worksheet 'the import sheet
Dim wsMaster As Worksheet 'the master sheet
Dim rData As Range 'the data table
Dim rDataCell As Range 'current data cell
Dim lRow As Long 'row in master

' set the master
Set wsMaster = ThisWorkbook.Worksheets(szMasterSheetName)
'set the first free row in master
lRow = wsMaster.Range(szMaster1stCell).CurrentRegion.Row _
+ wsMaster.Range(szMaster1stCell).CurrentRegion.Rows.Count
'set the data details
Set wsData = ActiveSheet
Set rData = wsData.UsedRange
'loop thru each used cell where not blank
For Each rDataCell In rData
If rDataCell <> "" Then
wsMaster.Cells(lRow, lColumn) = rDataCell
lRow = lRow + 1
End If
Next rDataCell
End Sub
'--end

 

[Tom Ogilvy]

Sub CopyDatatoMaster()
Dim rng as Range, cell as Range
Dim lrow as Long
with Workbooks("Source.xls").Worksheets(1)
set rng = .Range("A1").currentRegion
' if headers in the sheet
' set rng = rng.Offset(1,0).Resize(rng.rows.count-1)
end with
With workbooks("Master.xls").Worksheets(1)
lrow = .Cells(rows.count,1).End(xlup).row + 1
for each cell in rng
.cells(lrow,1).Value = cell.Value
lrow = lrow + 1
next
End With
End Sub

Adjust to fit the actual names and locations