Excel vba fill column to end of data

Last Edited By Krjb Donovan
Last Updated: Mar 05, 2014 09:34 PM GMT

Question

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
   

Answer

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

©2021 eLuminary LLC. All rights reserved.