Urgent help required

[praveenlal]

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.

 

[praveenlal]

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]

@praveenlal Does the following code do the same thing as your last post #2?

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