Copying column titles from different workbooks into new workbook

[slimano]

Hello,

I'm trying to copy data from 5 different worksbooks into a single new workbook. The code is as follows:

Sub tiso()

Dim fn, e, wb As Workbook
fn = Application.GetOpenFilename(FileFilter:="Microsoft excel files (*.xls), *.xls", _
                     Title:="Press CTRL Key to Select Multiple Files", MultiSelect:=True)
If Not IsArray(fn) Then Exit Sub
Set wb = Workbooks.Add
wb.SaveAs Filename:="C:\tiso\compiled.xls"


For Each e In fn
    With Workbooks.Open(e)
        With .Sheets(1)
            LastRow = Range("A65536").End(xlUp).Row
            Range("A2", Cells(LastRow, "O")).Copy
            wb.Sheets(1).Cells(wb.Sheets(1).Cells.SpecialCells(11).Row + 1, 1).PasteSpecial xlPasteValues
        End With
        .Close False
    End With
Next

Application.CutCopyMode = False
Set wb = Nothing

End Sub

My problem is with how to get the macro to copy the Row 1 which is present in all the 5 worksheets to appear on ONLY Row 1 in the new worksheet.

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1	Transaction Ref.	Debit Acct No	Debit Acct Name	Debit Currency	Debit Amount	Credit Their Ref	Credit Acct No	Credit Currency	COMMISSION.AMT	CHARGE.AMT	Amount Debited	Amount Credited	Local Amount Debited	Local Amt Credited	Processing Date
Sheet1

 

[Andrew Poulsom]

Try (untested):

Sub tiso()
Dim fn, e, wb As Workbook
Dim LastRow As Long
Dim NextCell As Range
Dim First As Boolean
fn = Application.GetOpenFilename(FileFilter:="Microsoft excel files (*.xls), *.xls", _
                     Title:="Press CTRL Key to Select Multiple Files", MultiSelect:=True)
If Not IsArray(fn) Then Exit Sub
Set wb = Workbooks.Add
wb.SaveAs Filename:="C:\tiso\compiled.xls"
First = True
For Each e In fn
    With Workbooks.Open(e)
        With .Sheets(1)
            LastRow = Range("A65536").End(xlUp).Row
            Range("A2", Cells(LastRow, "O")).Copy
            Set NextCell = wb.Sheets(1).Cells(wb.Sheets(1).Cells.SpecialCells(11).Row + 1, 1)
            With NextCell
                .PasteSpecial xlPasteValues
                If First = True Then
                    First = False
                Else
                    .EntireRow.Delete
                End If
            End With
        End With
        .Close False
    End With
Next
Application.CutCopyMode = False
Set wb = Nothing
End Sub

 

[slimano]

Thanks Andrew,

What i meant was that the column headings should show in Row1 of the new workbook only as well as add on the data from the 5 worksheets starting at Row2.

My code was compiling all the data into the new workbook but left Row1 blank that's what i seek to correct.

The new code does not make the Row1 appear, rather Row1 of all the other 4 workbooks except the very first one are blanked out.

Thanks.

 

[Andrew Poulsom]

Then you need (which I didn't spot):

Range("A1", Cells(LastRow, "O")).Copy

 

[slimano]

Andrew thanks,

When i run that, it worked but started populating the new workbook from Row2.

Data from workbook1 and workbook2 followed each other smoothly but subsequent data sets left a blank before adding on new data from another workbook.

So i edited to:

 Set NextCell = wb.Sheets(1).Cells(wb.Sheets(1).Cells.SpecialCells(11).[COLOR="Red"]Row[/COLOR], 1)

However, that started from Row1 and eliminated the blanks that appeared earlier, but the first data set was short by one row.

 

[Andrew Poulsom]

The data would always have started in row 2. Can't you just delete row 1 at the end of your macro?

 

[slimano]

Hello,

I have 2 sets of data (100 and 101) for a set of entities (A, B, C, D) that i want to merge.
I have written a macro that combines all the data of 101 for A,B,C,D into one file (data 101) and also combines all the data of 100 for A,B,C,D into another file (data 100).

Now i want to merge the 2 files into a single master file called "combined" in a specific format and save it. Can you please help?

my code so far is as follows:

Sub tiso()
Dim fn, e, wb As Workbook
Dim LastRow As Long
Dim NextCell As Range
Dim First As Boolean
Dim sAppPath As String, sFileName As String, sDate As String

fn = Application.GetOpenFilename(FileFilter:="Microsoft excel files (*.xls), *.xls", _
                     Title:="Go to Data 100 and Press CTRL A to Select All the Files", MultiSelect:=True)
If Not IsArray(fn) Then Exit Sub
Set wb = Workbooks.Add
'wb.SaveAs Filename:="C:\tiso\compiled & Format(Date, "").xls"


sAppPath = "c:\tiso\"
sDate = Replace(FormatDateTime(Now(), vbShortDate), "/", "-")
sFileName = sAppPath & "Data 100  " & sDate & ".xls"

ActiveWorkbook.SaveAs Filename:= _
sFileName, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False

For Each e In fn
    With Workbooks.Open(e)
        With .Sheets(1)
            'LastRow = Range("A65536").End(xlUp).Row
            'Range("B15", Cells(LastRow + 1, "J")).Copy
            Range("a4:b4").Cells.Copy
            wb.Sheets(1).Cells(wb.Sheets(1).Cells.SpecialCells(11).Row + 2, 2).PasteSpecial xlPasteValues
            Range("b15 : h15,b17 : h17").Cells.Copy
            wb.Sheets(1).Cells(wb.Sheets(1).Cells.SpecialCells(11).Row + 2, 2).PasteSpecial xlPasteValues
           ' Range("b17 : h17").Cells.Copy
            'wb.Sheets(1).Cells(wb.Sheets(1).Cells.SpecialCells(11).Row + 1, 2).PasteSpecial xlPasteValues
        End With
        .Close False
    End With
Next

Application.CutCopyMode = False
Set wb = Nothing




fn = Application.GetOpenFilename(FileFilter:="Microsoft excel files (*.xls), *.xls", _
                     Title:="Go to Data 101 and Press CTRL A to Select All the Files", MultiSelect:=True)
If Not IsArray(fn) Then Exit Sub
Set wb = Workbooks.Add
'wb.SaveAs Filename:="C:\tiso\compiled & Format(Date, "").xls"


sAppPath = "c:\tiso\"
sDate = Replace(FormatDateTime(Now(), vbShortDate), "/", "-")
sFileName = sAppPath & "Data 101  " & sDate & ".xls"

ActiveWorkbook.SaveAs Filename:= _
sFileName, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False

For Each e In fn
    With Workbooks.Open(e)
        With .Sheets(1)
            'LastRow = Range("A65536").End(xlUp).Row
            'Range("B15", Cells(LastRow + 1, "J")).Copy
            Range("a4:b4").Cells.Copy
            wb.Sheets(1).Cells(wb.Sheets(1).Cells.SpecialCells(11).Row + 2, 2).PasteSpecial xlPasteValues
            Range("b15 : d16").Cells.Copy
            wb.Sheets(1).Cells(wb.Sheets(1).Cells.SpecialCells(11).Row + 2, 2).PasteSpecial xlPasteValues
           ' Range("b17 : h17").Cells.Copy
            'wb.Sheets(1).Cells(wb.Sheets(1).Cells.SpecialCells(11).Row + 1, 2).PasteSpecial xlPasteValues
        End With
        .Close False
    End With
Next

Application.CutCopyMode = False
Set wb = Nothing




End Sub

Data 100

Excel Workbook
	A	B	C	D	E	F	G	H	I
1	*	*	*	Data 100	*	*	*	*	*
2	*	*	*	*	*	*	*	*	*
3	*	Data A	*	*	*	*	*	*	*
4	*	*	*	*	*	*	*	*	*
5	*	EQUIVALENT( MILLONS)	3292668	LONG	-11638	SHORT	737897.1	LONG	*
6	*	NET OWN FUNDS(NOFs)	7.32	LONG	-0.03	SHORT	1.64	LONG	*
7	*	*	*	*	*	*	*	*	*
8	*	Data B	*	*	*	*	*	*	*
9	*	*	*	*	*	*	*	*	*
10	*	EQUIVALENT( MILLONS)	3292668	LONG	-11638	SHORT	737897.1	LONG	*
11	*	NET OWN FUNDS(NOFs)	7.32	LONG	-0.03	SHORT	1.64	LONG	*
12	*	*	*	*	*	*	*	*	*
13	*	Data C	*	*	*	*	*	*	*
14	*	*	*	*	*	*	*	*	*
15	*	EQUIVALENT( MILLONS)	3292668	LONG	-11638	SHORT	737897.1	LONG	*
16	*	NET OWN FUNDS(NOFs)	7.32	LONG	-0.03	SHORT	1.64	LONG	*
17	*	*	*	*	*	*	*	*	*
18	*	Data D	*	*	*	*	*	*	*
19	*	*	*	*	*	*	*	*	*
20	*	EQUIVALENT( MILLONS)	3292668	LONG	-11638	SHORT	737897.1	LONG	*
21	*	NET OWN FUNDS(NOFs)	7.32	LONG	-0.03	SHORT	1.64	LONG	*
Sheet1

Data 101

Excel Workbook
	A	B	C	D	E
1	*	*	*	Data 101	*
2	*	*	*	*	*
3	*	Data A	*	*	*
4	*	*	*	*	*
5	*	NOP IN PERCENTAGE%	27232600	LONG	*
6	*	AFOP IN PERCENTAGE	1.53	LONG	*
7	*	*	*	*	*
8	*	Data B	*	*	*
9	*	*	*	*	*
10	*	NOP IN PERCENTAGE%	27232600	LONG	*
11	*	AFOP IN PERCENTAGE	1.53	LONG	*
12	*	*	*	*	*
13	*	Data C	*	*	*
14	*	*	*	*	*
15	*	NOP IN PERCENTAGE%	27232600	LONG	*
16	*	AFOP IN PERCENTAGE	1.53	LONG	*
17	*	*	*	*	*
18	*	Data D	*	*	*
19	*	*	*	*	*
20	*	NOP IN PERCENTAGE%	27232600	LONG	*
21	*	AFOP IN PERCENTAGE	1.53	LONG	*
22	*	*	*	*	*
Sheet1

Combined should look like this:

Excel Workbook
	B	C	D	E	F	G	H	I
1	*	*	*	*	*	*	*	*
2	Data A	*	*	*	*	*	*	*
3	*	*	*	*	*	*	*	*
4	EQUIVALENT( MILLONS)	4,380,526.71	LONG	22,732.22	LONG	496,252.16	LONG	*
5	NET OWN FUNDS(NOFs)	*	*	*	*	*	*	45,001,589.54
6	NOP IN PERCENTAGE	9.73	LONG	0.05	LONG	1.10	LONG	*
7	AFOP IN PERCENTAGE	*	*	*	*	*	*	12.72
8	*	*	*	*	*	*	*	*
9	Data B	*	*	*	*	*	*	*
10	*	*	*	*	*	*	*	*
11	EQUIVALENT( MILLONS)	-16,985,152.40	SHORT	-464,904.61	SHORT	96,455.07	LONG	*
12	NET OWN FUNDS(NOFs)	*	*	*	*	*	*	264,186,952.00
13	NOP IN PERCENTAGE%	-6.43	SHORT	-0.18	SHORT	0.04	LONG	*
14	AFOP IN PERCENTAGE	*	*	*	*	*	*	-6.61
15	*	*	*	*	*	*	*	*
16	Data C	*	*	*	*	*	*	*
17	*	*	*	*	*	*	*	*
18	EQUIVALENT( MILLONS)	238,186.15	LONG	75,261.90	LONG	23,755.17	LONG	*
19	NET OWN FUNDS(NOFs)	*	*	*	*	*	*	27,232,600.00
20	NOP IN PERCENTAGE%	0.87	LONG	0.28	LONG	0.09	LONG	*
21	AFOP IN PERCENTAGE%	*	*	*	*	*	*	1.69
22	*	*	*	*	*	*	*	*
23	Data D	*	*	*	*	*	*	*
24	*	*	*	*	*	*	*	*
25	EQUIVALENT( MILLONS)	1,479,823.88	LONG	179,947.64	LONG	1,681,151.03	LONG	*
26	NET OWN FUNDS(NOFs)	*	*	*	*	*	*	22,331,551.00
27	NOP IN PERCENTAGE%	6.63	LONG	0.81	LONG	7.53	LONG	*
28	AFOP IN PERCENTAGE%	*	*	*	*	*	*	14.96
Sheet1

 

[slimano]

Sorry i had issues pasting my excel shots

It's as follows

 

[slimano]

data 100

Excel Workbook
	A	B	C	D	E	F	G	H	I
1	*	*	*	Data 100	*	*	*	*	*
2	*	*	*	*	*	*	*	*	*
3	*	Data A	*	*	*	*	*	*	*
4	*	*	*	*	*	*	*	*	*
5	*	EQUIVALENT( MILLONS)	3292668	LONG	-11638	SHORT	737897.1	LONG	*
6	*	NET OWN FUNDS(NOFs)	7.32	LONG	-0.03	SHORT	1.64	LONG	*
7	*	*	*	*	*	*	*	*	*
8	*	Data B	*	*	*	*	*	*	*
9	*	*	*	*	*	*	*	*	*
10	*	EQUIVALENT( MILLONS)	3292668	LONG	-11638	SHORT	737897.1	LONG	*
11	*	NET OWN FUNDS(NOFs)	7.32	LONG	-0.03	SHORT	1.64	LONG	*
12	*	*	*	*	*	*	*	*	*
13	*	Data C	*	*	*	*	*	*	*
14	*	*	*	*	*	*	*	*	*
15	*	EQUIVALENT( MILLONS)	3292668	LONG	-11638	SHORT	737897.1	LONG	*
16	*	NET OWN FUNDS(NOFs)	7.32	LONG	-0.03	SHORT	1.64	LONG	*
17	*	*	*	*	*	*	*	*	*
18	*	Data D	*	*	*	*	*	*	*
19	*	*	*	*	*	*	*	*	*
20	*	EQUIVALENT( MILLONS)	3292668	LONG	-11638	SHORT	737897.1	LONG	*
21	*	NET OWN FUNDS(NOFs)	7.32	LONG	-0.03	SHORT	1.64	LONG	*
Sheet1

data 101

Excel Workbook
	A	B	C	D	E
1	*	*	*	Data 101	*
2	*	*	*	*	*
3	*	Data A	*	*	*
4	*	*	*	*	*
5	*	NOP IN PERCENTAGE%	27232600	LONG	*
6	*	AFOP IN PERCENTAGE	1.53	LONG	*
7	*	*	*	*	*
8	*	Data B	*	*	*
9	*	*	*	*	*
10	*	NOP IN PERCENTAGE%	27232600	LONG	*
11	*	AFOP IN PERCENTAGE	1.53	LONG	*
12	*	*	*	*	*
13	*	Data C	*	*	*
14	*	*	*	*	*
15	*	NOP IN PERCENTAGE%	27232600	LONG	*
16	*	AFOP IN PERCENTAGE	1.53	LONG	*
17	*	*	*	*	*
18	*	Data D	*	*	*
19	*	*	*	*	*
20	*	NOP IN PERCENTAGE%	27232600	LONG	*
21	*	AFOP IN PERCENTAGE	1.53	LONG	*
22	*	*	*	*	*
Sheet1

combined should look like this:

Excel Workbook
	B	C	D	E	F	G	H	I
1	*	*	*	*	*	*	*	*
2	Data A	*	*	*	*	*	*	*
3	*	*	*	*	*	*	*	*
4	EQUIVALENT( MILLONS)	4,380,526.71	LONG	22,732.22	LONG	496,252.16	LONG	*
5	NET OWN FUNDS(NOFs)	*	*	*	*	*	*	45,001,589.54
6	NOP IN PERCENTAGE	9.73	LONG	0.05	LONG	1.10	LONG	*
7	AFOP IN PERCENTAGE	*	*	*	*	*	*	12.72
8	*	*	*	*	*	*	*	*
9	Data B	*	*	*	*	*	*	*
10	*	*	*	*	*	*	*	*
11	EQUIVALENT( MILLONS)	-16,985,152.40	SHORT	-464,904.61	SHORT	96,455.07	LONG	*
12	NET OWN FUNDS(NOFs)	*	*	*	*	*	*	264,186,952.00
13	NOP IN PERCENTAGE%	-6.43	SHORT	-0.18	SHORT	0.04	LONG	*
14	AFOP IN PERCENTAGE	*	*	*	*	*	*	-6.61
15	*	*	*	*	*	*	*	*
16	Data C	*	*	*	*	*	*	*
17	*	*	*	*	*	*	*	*
18	EQUIVALENT( MILLONS)	238,186.15	LONG	75,261.90	LONG	23,755.17	LONG	*
19	NET OWN FUNDS(NOFs)	*	*	*	*	*	*	27,232,600.00
20	NOP IN PERCENTAGE%	0.87	LONG	0.28	LONG	0.09	LONG	*
21	AFOP IN PERCENTAGE%	*	*	*	*	*	*	1.69
22	*	*	*	*	*	*	*	*
23	Data D	*	*	*	*	*	*	*
24	*	*	*	*	*	*	*	*
25	EQUIVALENT( MILLONS)	1,479,823.88	LONG	179,947.64	LONG	1,681,151.03	LONG	*
26	NET OWN FUNDS(NOFs)	*	*	*	*	*	*	22,331,551.00
27	NOP IN PERCENTAGE%	6.63	LONG	0.81	LONG	7.53	LONG	*
28	AFOP IN PERCENTAGE%	*	*	*	*	*	*	14.96
Sheet1