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

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number

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,933
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,164,565
Messages
5,838,135
Members
430,530
Latest member
sonofagunn123

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