I have 20 different workbooks. I have vba code to open each workbook, insert/add two extra columns, and title the columns starting on row 3.
Each workbook has the following:
ColumnA ColumnB ColumnC
Row 1 Branch1 Row 2 Row 3 BranchId System Row 4 .. Row50
I want to copy ColumnC Branch1 (COL1,ROW1) to Row4 ColumnB (COL2,ROW4). I want to copy it down to as many rows that have data. So that if it has 50 rows, 50 rows are copied/pasted, if it has 100 rows, 100 rows are copied/pasted. I don't know how many rows of data are in each workbook.
ColumnA ColumnB ColumnC
Row 1 Branch1 Row 2 Row 3 BranchId System Row 4 Branch1 Row 5 Branch1 .. Branch1 Row50 Branch1
Here is the code that I am using. It opens each workbook and copy C1 to B4:B50. I chose 50 just to be on the safe side. It could be a 100 rows, or 200 rows, etc.
Sub ExecuteA08Fill()
' Declare the variables
Dim MyPath As String Dim MyFile As String Dim wbOpen As Workbook
' Define the path to the folder containing the target files (change accordingly)
MyPath = "C:\FAA 02 COPIED SPREADSHEETS\"
' Call the first .xls file (change the file extension accordingly)
MyFile = Dir(MyPath & "*.xls")
' Loop through each file in the folder
Do While Len(MyFile) > 0
' Open the current file
Set wbOpen = Workbooks.Open(Filename:=MyPath & MyFile)
Range("C1").Copy
Range("B4").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False
Range("B4").Select Application.CutCopyMode = False Selection.Copy Range("B5:B50").Select ActiveSheet.Paste ActiveWorkbook.Close True
' Call the next file
MyFile = Dir Loop
Achilles
Assuming I can use column 1 to find the last row to use then:
Sub ExecuteA08Fill()
' Declare the variables
Dim MyPath As String Dim MyFile As String Dim wbOpen As Workbook Dim lastrow as Long
' Define the path to the folder containing the target files (change accordingly)
MyPath = "C:\FAA 02 COPIED SPREADSHEETS\"
' Call the first .xls file (change the file extension accordingly)
MyFile = Dir(MyPath & "*.xls")
' Loop through each file in the folder
Do While Len(MyFile) > 0
' Open the current file
Set wbOpen = Workbooks.Open(Filename:=MyPath & MyFile) lastrow = cells(rows.count,1).end(xlup).row
Range("C1").Copy
Range("B4").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False
Range("B4").Select Application.CutCopyMode = False Selection.Copy Range("B5:B" & lastrow).Select ActiveSheet.Paste ActiveWorkbook.Close True
' Call the next file
MyFile = Dir Loop
should do it.
Advertisement