VBA Loop Visible Cells Column, Copy left 7 digits

[DonellaD]

Hi,
I'm pretty new to VBA and desperately need help! I have to loop through a column of data, select only the visible cells in that column, extract the left seven characters then paste them into an external workbook I've already created. This data will be pasted on sheet2 of the external workbook. I have already copied data from the master workbook, opened a new workbook and pasted that data on sheet1. Now I need to go back to the master workbook, sheet2, to the filtered column AD, copy only the first 7 digits in each cell and paste it onto sheet2 in the workbook I have already created.

I know how to loop, select.SpecialCells(xlCellTypeVisible), get only the left 7 characters in a cell, but I'm having difficulty piecing it all together into a loop that will do all of these and paste it into an external workbook on sheet 2. The filtered range will always be different, as it displays data for the individual unit that is selected so it can be anywhere from a 3 or 4 rows to 20.

Please help...I've been struggling with this for more than a week and I cannot find anything that does what I need to accomplish.

 

[Ferdi24]

This code is a bit clumsy but should work in case nobody responds with a squeaky clean alternative

Option Explicit 
Sub VisibleCellsFirstSeven()
Dim i As Long
Dim mCell As Range
Dim DataRange As Range
Dim TempStore As String
Dim ExternalWorkbook As Workbook
Dim InternalWorkbook As Workbook

'Selects the column you have currently clicked in to work with
Set DataRange = ActiveWorkbook.ActiveSheet.UsedRange.Columns(ActiveCell.Column - ActiveSheet.UsedRange.Column + 1)

'Which is the external workbook?
Set InternalWorkbook = ThisWorkbook
Set ExternalWorkbook = Workbooks.Open("C:\...\...xls") ' INSERT YOUR EXTERNAL FILENAME HERE
InternalWorkbook.Activate


For i = 0 To DataRange.Rows.Count - 1
Set mCell = Cells(DataRange.Row, DataRange.Column).Offset(i)
    If mCell.EntireRow.Hidden = False Then
        If Len(mCell.Value) >= 7 Then
          TempStore = Left(mCell.Value, 7)
          'On this sheet find the last row in Column A
          ExternalWorkbook.Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = TempStore
        End If
    End If
Next i
ExternalWorkbook.Activate
End Sub

 

[DonellaD]

oh my goodness!!! Thank you so much!!! I will try this now and see if it works!!!!