ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   macro - small change (https://www.excelbanter.com/excel-programming/412444-macro-small-change.html)

theo

macro - small change
 
This macor works great - but I only want to copy Row 2. ****HERE****
Can someone help?
Thanks
T

Sub Master()

Dim myBook As Workbook

Dim myCalc As XlCalculation

Dim myShtName As String



With Application

.EnableEvents = False

.DisplayAlerts = False

myCalc = .Calculation

.Calculation = xlCalculationManual

End With



On Error Resume Next

With Application.FileSearch

.NewSearch

'Change this to your directory

.LookIn = "H:\WR Intake"
.SearchSubFolders = False

.FileType = msoFileTypeExcelWorkbooks

If .Execute() 0 Then

For i = 1 To .FoundFiles.Count

Set myBook = Workbooks.Open(.FoundFiles(i))

myBook.Worksheets(1).Range("A2").CurrentRegion.Cop y _
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp)(2 )
*****Don't want everything - just row 2 ***********
myBook.Close False

Next i

Else: MsgBox "There were no files found."

End If

End With

With Application

.EnableEvents = True

.DisplayAlerts = True

.Calculation = myCalc

End With



End Sub


Don Guillett

macro - small change
 
myBook.Worksheets(1).Range("A2").CurrentRegion.Cop y _
try
myBook.Worksheets(1).Range("A2").EntireRow.Copy _
--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Theo" wrote in message
...
This macor works great - but I only want to copy Row 2. ****HERE****
Can someone help?
Thanks
T

Sub Master()

Dim myBook As Workbook

Dim myCalc As XlCalculation

Dim myShtName As String



With Application

.EnableEvents = False

.DisplayAlerts = False

myCalc = .Calculation

.Calculation = xlCalculationManual

End With



On Error Resume Next

With Application.FileSearch

.NewSearch

'Change this to your directory

.LookIn = "H:\WR Intake"
.SearchSubFolders = False

.FileType = msoFileTypeExcelWorkbooks

If .Execute() 0 Then

For i = 1 To .FoundFiles.Count

Set myBook = Workbooks.Open(.FoundFiles(i))

myBook.Worksheets(1).Range("A2").CurrentRegion.Cop y _
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp)(2 )
*****Don't want everything - just row 2 ***********
myBook.Close False

Next i

Else: MsgBox "There were no files found."

End If

End With

With Application

.EnableEvents = True

.DisplayAlerts = True

.Calculation = myCalc

End With



End Sub



theo

macro - small change
 
Yup! That worked.
The only problem that I have now is that I want it to paste the data as
paste/special values - otherwise it's copying formulas and the data does not
match the original.
I tried adding a statements .....
..PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

but I've either got it in the wrong place, or that's just not the right way
to do it.
Any suggestions?
Thanks Don!
T
"Don Guillett" wrote:

myBook.Worksheets(1).Range("A2").CurrentRegion.Cop y _

try
myBook.Worksheets(1).Range("A2").EntireRow.Copy _
--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Theo" wrote in message
...
This macor works great - but I only want to copy Row 2. ****HERE****
Can someone help?
Thanks
T

Sub Master()

Dim myBook As Workbook

Dim myCalc As XlCalculation

Dim myShtName As String



With Application

.EnableEvents = False

.DisplayAlerts = False

myCalc = .Calculation

.Calculation = xlCalculationManual

End With



On Error Resume Next

With Application.FileSearch

.NewSearch

'Change this to your directory

.LookIn = "H:\WR Intake"
.SearchSubFolders = False

.FileType = msoFileTypeExcelWorkbooks

If .Execute() 0 Then

For i = 1 To .FoundFiles.Count

Set myBook = Workbooks.Open(.FoundFiles(i))

myBook.Worksheets(1).Range("A2").CurrentRegion.Cop y _
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp)(2 )
*****Don't want everything - just row 2 ***********
myBook.Close False

Next i

Else: MsgBox "There were no files found."

End If

End With

With Application

.EnableEvents = True

.DisplayAlerts = True

.Calculation = myCalc

End With



End Sub




Don Guillett

macro - small change
 
Always nice to FULLY state your question the FIRST time. Try to copy and
then paste

myBook.Worksheets(1).Range("A2").entirerow.Copy 'No continuation
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp)(2 ) _
.PasteSpecial Paste:=xlPasteValues

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Theo" wrote in message
...
Yup! That worked.
The only problem that I have now is that I want it to paste the data as
paste/special values - otherwise it's copying formulas and the data does
not
match the original.
I tried adding a statements .....
.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

but I've either got it in the wrong place, or that's just not the right
way
to do it.
Any suggestions?
Thanks Don!
T
"Don Guillett" wrote:

myBook.Worksheets(1).Range("A2").CurrentRegion.Cop y _

try
myBook.Worksheets(1).Range("A2").EntireRow.Copy _
--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Theo" wrote in message
...
This macor works great - but I only want to copy Row 2. ****HERE****
Can someone help?
Thanks
T

Sub Master()

Dim myBook As Workbook

Dim myCalc As XlCalculation

Dim myShtName As String



With Application

.EnableEvents = False

.DisplayAlerts = False

myCalc = .Calculation

.Calculation = xlCalculationManual

End With



On Error Resume Next

With Application.FileSearch

.NewSearch

'Change this to your directory

.LookIn = "H:\WR Intake"
.SearchSubFolders = False

.FileType = msoFileTypeExcelWorkbooks

If .Execute() 0 Then

For i = 1 To .FoundFiles.Count

Set myBook = Workbooks.Open(.FoundFiles(i))

myBook.Worksheets(1).Range("A2").CurrentRegion.Cop y _
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp)(2 )
*****Don't want everything - just row 2 ***********
myBook.Close False

Next i

Else: MsgBox "There were no files found."

End If

End With

With Application

.EnableEvents = True

.DisplayAlerts = True

.Calculation = myCalc

End With



End Sub





theo

macro - small change
 
I didn't realize I had the question until after I saw the result. Sorry I
took too much of your time.
T

"Don Guillett" wrote:

Always nice to FULLY state your question the FIRST time. Try to copy and
then paste

myBook.Worksheets(1).Range("A2").entirerow.Copy 'No continuation
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp)(2 ) _
.PasteSpecial Paste:=xlPasteValues

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Theo" wrote in message
...
Yup! That worked.
The only problem that I have now is that I want it to paste the data as
paste/special values - otherwise it's copying formulas and the data does
not
match the original.
I tried adding a statements .....
.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

but I've either got it in the wrong place, or that's just not the right
way
to do it.
Any suggestions?
Thanks Don!
T
"Don Guillett" wrote:

myBook.Worksheets(1).Range("A2").CurrentRegion.Cop y _
try
myBook.Worksheets(1).Range("A2").EntireRow.Copy _
--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Theo" wrote in message
...
This macor works great - but I only want to copy Row 2. ****HERE****
Can someone help?
Thanks
T

Sub Master()

Dim myBook As Workbook

Dim myCalc As XlCalculation

Dim myShtName As String



With Application

.EnableEvents = False

.DisplayAlerts = False

myCalc = .Calculation

.Calculation = xlCalculationManual

End With



On Error Resume Next

With Application.FileSearch

.NewSearch

'Change this to your directory

.LookIn = "H:\WR Intake"
.SearchSubFolders = False

.FileType = msoFileTypeExcelWorkbooks

If .Execute() 0 Then

For i = 1 To .FoundFiles.Count

Set myBook = Workbooks.Open(.FoundFiles(i))

myBook.Worksheets(1).Range("A2").CurrentRegion.Cop y _
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp)(2 )
*****Don't want everything - just row 2 ***********
myBook.Close False

Next i

Else: MsgBox "There were no files found."

End If

End With

With Application

.EnableEvents = True

.DisplayAlerts = True

.Calculation = myCalc

End With



End Sub






Don Guillett

macro - small change
 

Is it now working as desired?
--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Theo" wrote in message
...
I didn't realize I had the question until after I saw the result. Sorry I
took too much of your time.
T

"Don Guillett" wrote:

Always nice to FULLY state your question the FIRST time. Try to copy and
then paste

myBook.Worksheets(1).Range("A2").entirerow.Copy 'No continuation
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp)(2 ) _
.PasteSpecial Paste:=xlPasteValues

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Theo" wrote in message
...
Yup! That worked.
The only problem that I have now is that I want it to paste the data as
paste/special values - otherwise it's copying formulas and the data
does
not
match the original.
I tried adding a statements .....
.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

but I've either got it in the wrong place, or that's just not the right
way
to do it.
Any suggestions?
Thanks Don!
T
"Don Guillett" wrote:

myBook.Worksheets(1).Range("A2").CurrentRegion.Cop y _
try
myBook.Worksheets(1).Range("A2").EntireRow.Copy _
--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Theo" wrote in message
...
This macor works great - but I only want to copy Row 2. ****HERE****
Can someone help?
Thanks
T

Sub Master()

Dim myBook As Workbook

Dim myCalc As XlCalculation

Dim myShtName As String



With Application

.EnableEvents = False

.DisplayAlerts = False

myCalc = .Calculation

.Calculation = xlCalculationManual

End With



On Error Resume Next

With Application.FileSearch

.NewSearch

'Change this to your directory

.LookIn = "H:\WR Intake"
.SearchSubFolders = False

.FileType = msoFileTypeExcelWorkbooks

If .Execute() 0 Then

For i = 1 To .FoundFiles.Count

Set myBook = Workbooks.Open(.FoundFiles(i))

myBook.Worksheets(1).Range("A2").CurrentRegion.Cop y _
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp)(2 )
*****Don't want everything - just row 2 ***********
myBook.Close False

Next i

Else: MsgBox "There were no files found."

End If

End With

With Application

.EnableEvents = True

.DisplayAlerts = True

.Calculation = myCalc

End With



End Sub








All times are GMT +1. The time now is 10:25 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com