Urgent help required

praveenlal

New Member
Joined
Oct 27, 2021
Messages
34
Office Version
  1. 2016
Platform
  1. Windows
Sub TextBox1_Click()

ChDir _
"C:\Users\"

ActiveCell.FormulaR1C1 = "='[Book1.xlsm]Sheet1'!R2C2"
ActiveWorkbook.SaveAs Filename:= _
"ABC.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Range("A1").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.Save

Workbooks.Open Filename:= _
"C:\Users\ABC.xlsx"
Range("A6:B6").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A8:B8").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
ActiveWorkbook.Save
ActiveWindow.Close

End Sub

I have created this query for sample file ABC.xlsx. I have multiples such files, I want to add loop here and file name should be same as Book1 (R2C5). Can anyone urgently help.
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

praveenlal

New Member
Joined
Oct 27, 2021
Messages
34
Office Version
  1. 2016
Platform
  1. Windows
Sub TextBox1_Click()

ChDir _
"C:\Users\2021"

ActiveCell.FormulaR1C1 = "='[Book1.xlsm]Sheet1'!R2C2"
ActiveWorkbook.SaveAs Filename:= _
"ABC.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Range("A1").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.Save


ActiveCell.FormulaR1C1 = "='[Book1.xlsm]Sheet1'!R3C2"
ActiveWorkbook.SaveAs Filename:= _
"DEF.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Range("A1").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.Save

Workbooks.Open Filename:= _
"C:\Users\2021\ABC.xlsx"
Range("A6:B6").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A8:B8").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
ActiveWorkbook.Save
ActiveWindow.Close


Workbooks.Open Filename:= _
"C:\Users\2021\DEF.xlsx"
Range("A6:B6").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A8:B8").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
ActiveWorkbook.Save
ActiveWindow.Close

End Sub

I have 400 such files where I want to save as files first, then open all files and paste special values row 6 and 8 & column A & B. Please help urgently, if anyone can
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
2,844
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
@praveenlal Does the following code do the same thing as your last post #2?

VBA Code:
Sub TextBox1_Click()
'
'--------------------------------------------------------------------------------------------------------
'
    ActiveCell.Formula = "='[Book1.xlsm]Sheet1'!B2"
    ActiveWorkbook.SaveAs Filename:="ABC.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
'
    Range("A1").Copy
    Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ActiveWorkbook.Save
'
'--------------------------------------------------------------------------------------------------------
'
    ActiveCell.Formula = "='[Book1.xlsm]Sheet1'!B3"
    ActiveWorkbook.SaveAs Filename:="DEF.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
'
    Range("A1").Copy
    Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ActiveWorkbook.Save
'
'--------------------------------------------------------------------------------------------------------
'
    Workbooks.Open Filename:="C:\Users\2021\ABC.xlsx"
    Range("A6:B6").Copy
    Range("A6:B6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'
    Range("A8:B8").Copy
    Range("A8:B8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'
    ActiveWorkbook.Save
    ActiveWindow.Close
'
'--------------------------------------------------------------------------------------------------------
'
    Workbooks.Open Filename:="C:\Users\2021\DEF.xlsx"
    Range("A6:B6").Copy
    Range("A6:B6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'
    Range("A8:B8").Copy
    Range("A8:B8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'
    Application.CutCopyMode = False
'
    Range("A1").Select
'
    ActiveWorkbook.Save
    ActiveWindow.Close
End Sub
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,163,477
Messages
5,831,904
Members
430,090
Latest member
bjonesh2o

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top