vba in excel

vba in excel

• Nemanja Trifunovic

  Thanks for that, i will give it a try
  

• Utkarsh

  You can change the 30 in the code (2 as I posted it) to a variable of type long, the below line sets variable nEndRowIndex to the last non blank row in column A. It effectively does the same as pressing End then Down in A2.

  nEndRowIndex = .Range("A2").End(-4121).Row

  In my code the filename is changed using letter corresponding to the line number, change this to

  strFileName = "C:\Files\" & ColumnLetter(lngRow) & strRow & ".xls"

  this will give A1.xls then B2.xls etc, Row 27 will be AA27.xls
  

  
  

• wizkid1

  Thanks for that but i do i scroll thru all of the data in the table
  

• mbelew

  Thanks ADG works a treat, much appreciated. It will take me sometime to get back into coding. Not done any since 1999.
  Thanks again
  
  John
  
  

• LC Johnny

  Apart from having to scroll thru all of the data in the table, each new workbook needs to have a filename, like A1 then B2 then C3 and so on. I hope this is not too difficult.

  Thankks John

  
  

• Gabriel Florit

  Public Sub CopyStuff()
  Dim lngRow As Long
  Dim strFileName As String
  Hi John

  Try the below, you can amend as necessary, I have added a function which will help name the file as per your example

  Public Sub CopyStuff()
  Dim lngRow As Long
  Dim strFileName As String
  Dim strRange, StrRow As String

  On Error Resume Next
  MkDir ("C:\Files")
  On Error GoTo 0
  For lngRow = 1 To 2
  StrRow = Trim$(Str$(lngRow))
  strRange = "A" & StrRow & ":B" & StrRow
  Range(strRange).Select
  Selection.Copy
  Workbooks.Add
  Range("A1:B1").Select
  ActiveSheet.Paste
  Application.CutCopyMode = False
  Application.DisplayAlerts = False ' this turns off file exists in location message
  strFileName = "C:\Files\" & ColumnLetter(lngRow) & "1.xls"
  ActiveWorkbook.SaveAs FileName:=strFileName, FileFormat:=xlNormal, _
  Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
  CreateBackup:=False
  
  ActiveWorkbook.Close
  
  
  Next
  End Sub

  Public Function ColumnLetter(ByVal ColumnNo As Long) As String
  Dim x As Long
  Dim y As Double

  If ColumnNo > 26 Then
  y = Int((ColumnNo - 1) / 26)
  ColumnLetter = Chr$(64 + y)
  x = ColumnNo - (Int(y) * 26)
  If x = 0 Then
  ColumnLetter = ColumnLetter & "Z"
  Else
  ColumnLetter = ColumnLetter & Chr$(64 + x)
  
  End If
  Else
  ColumnLetter = Chr$(64 + ColumnNo)
  End If

  End Function

  
  

• FiddlersRoof

  Hi John

  The for next loop does the scroll through and the new file names, I meant to change the 2 to 30 in the code I posted, also something went wrong with my paste as three extra lines were at the top.

  HTH

  
  

• EdgarGustavoPerezGonzalez

  Hi John

  Code would appear like below

  Public Sub CopyStuff()
  Dim lngRow As Long
  Dim strFileName As String
  Dim strRange, StrRow As String
  Dim nEndRowIndex As Long

  On Error Resume Next
  MkDir ("C:\Files")
  On Error GoTo 0
  nEndRowIndex = Range("A2").End(-4121).Row
  For lngRow = 1 To nEndRowIndex
  StrRow = Trim$(Str$(lngRow))
  strRange = "A" & StrRow & ":B" & StrRow
  Range(strRange).Select
  Selection.Copy
  Workbooks.Add
  Range("A1:B1").Select
  ActiveSheet.Paste
  Application.CutCopyMode = False
  Application.DisplayAlerts = False ' this turns off file exists in location message
  strFileName = "C:\Files\" & ColumnLetter(lngRow) & "1.xls"
  ActiveWorkbook.SaveAs Filename:=strFileName, FileFormat:=xlNormal, _
  Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
  CreateBackup:=False
  
  ActiveWorkbook.Close
  
  
  Next
  End Sub

  Public Function ColumnLetter(ByVal ColumnNo As Long) As String
  Dim x As Long
  Dim y As Double

  If ColumnNo > 26 Then
  y = Int((ColumnNo - 1) / 26)
  ColumnLetter = Chr$(64 + y)
  x = ColumnNo - (Int(y) * 26)
  If x = 0 Then
  ColumnLetter = ColumnLetter & "Z"
  Else
  ColumnLetter = ColumnLetter & Chr$(64 + x)
  
  End If
  Else
  ColumnLetter = Chr$(64 + ColumnNo)
  End If

  End Function

  
  

• computed_mind

  a dumb question, how do i incorporate the line below into my code
  nEndRowIndex = .Range("A2").End(-4121).Row
  
  Sorry for not understanding, been a long time since programming.
  
  Thanks
  
  John
  
  

• DelWare

  the table may have more than thirty lines of data, so i need to scroll thru the table until an empty cell is detected. I deleted those extra lines. works ok, just need to change code to name files A1, B2, C3, etc, but do not know how to do so, Hope you can help, will be very much appreciated. i have tried the for next loop but kept looping and looping even past an empty cell.

  Thanks again

  John

  
  
• vba in excel