copy multiple worksheet data from 2 different workbook
try this code
Sub GetData()
Set NewBkSht = ThisWorkbook.Sheets(1)
NewBkSht.Name = "Summary"
NewBkSht.Cells.ClearContents
filetoopen = Application _
.GetOpenFilename("Text Files (*.xl*), *.xl*")
If filetoopen = False Then
MsgBox ("cannot open file - Exitting Macro")
Exit Sub
End If
Set OldBk = Workbooks.Open(Filename:=filetoopen)
For Each sht In OldBk.Sheets
NewLastRow = NewBkSht.Range("A" & Rows.Count).End(xlUp).Row
If UCase(Right(sht.Name, 3)) = "ABC" Then
OldLastRow = sht.Range("J" & Rows.Count).End(xlUp).Row
sht.Range("J5:N" & OldLastRow).Copy _
Destination:=NewBkSht.Range("A" & (NewLastRow + 1))
End If
If UCase(Right(sht.Name, 3)) = "-AB" Then
OldLastRow = sht.Range("M" & Rows.Count).End(xlUp).Row
sht.Range("M5:R" & OldLastRow).Copy _
Destination:=NewBkSht.Range("A" & (NewLastRow + 1))
End If
Next sht
OldBk.Close savechanges:=False
End Sub
"Ita" wrote:
Hi,
How to translate the following into a working code in the following
scenario. The code will run in new workbook :-
1.From new workbook, open old workbook. To use
Application.GetOpenFilename(filefilter:="Excel Files, *.xl*")
2.If sheet name end with ABC or €“AB, copy range (J5:N & last row) from old
workbook to new workbook
3.If sheet name end with XYZ or -YZ, copy range (M5:R & last row) from old
workbook to new workbook
The worksheets are in alphabetical order (and same name). I want to copy the
values only from
old book - workbook(1).worksheet(1).range to
new book - workbook(2).worksheet(1).range
There are a total of 18 worksheets to copy from old workbook to new workbook.
Thank you.
|