CODEWITHSUNDEEP
vbaexcel
krop
krop

Reputation: 13

Need to copy certain data over workbooks

new to VBA here. I've been stuck on this problem for a while now:

Essentially, I need to create a macro that copies over specific data from one sheet to another, that is up to the user to specify. The catch is that while all the data is in one column (B), not all rows of the column have relevant entries; some are blank and some have other data that I don't want.

Only entries that begin with 4 numbers are wanted. I can't seem to get how the iterated copy-pasting works; what I've come up with is as follows:

'defining input

Dim dater As Date
dater = Range("B2")
If dater = False Then
    MsgBox "Date not specified"
         Exit Sub
End If

Dim sheetin As String
sheetin = Range("B5")
  If sheetin = "" Then
    MsgBox "Input Sheet not specified"
         Exit Sub
End If

Dim wbin As String
wbin = Range("B4")
  If wbin = "" Then
    MsgBox "Input workbook not specified"
         Exit Sub
End If

Dim sheetout As String
sheetout = Range("B9")
  If sheetout = "" Then
    MsgBox "Output Sheet not specified"
         Exit Sub
End If

Dim wbout As String
wbout = Range("B8")
  If wbout = "" Then
    MsgBox "Output Workbook not specified"
         Exit Sub
End If

Windows(wbout).Activate
Dim sh As Worksheet, existx As Boolean
For Each sh In Worksheets
If sh.Name Like sheetout Then existx = True: Exit For
Next
If existx = True Then
If Sheets(sheetout).Visible = False Then Sheets(sheetout).Visible = True
Else
Sheets.Add.Name = CStr(sheetout)


End If


'copy pasting values


Windows(wbin).Activate
Sheets(sheetin).Select
'specify maximum row
iMaxRow = 500
For iRow = 1 To iMaxRow


With Worksheets(sheetin).Cells(iRow, 2)
    'Check that cell is not empty.
    If .Value = "####*" Then
       .Copy Destination:=Workbooks(wbout).Worksheets(sheetout).Range("A" & i)
        'Else do nothing.
    End If
End With

Next iRow

End Sub

Subsequently i'll have to match data to these entries that have been copied over but I figure once i get the hang of how to do iterated stuff it shouldn't be too much of a problem. But right now i'm really stuck... Please help!

Upvotes: 0

Views: 54

Answers (1)

Bernard Saucier
Bernard Saucier

Reputation: 2270

It looks like it should work, except for that part : 

With Worksheets(sheetin).Cells(iRow, 2)
    If .Value = "####*" Then
       .Copy Destination:=Workbooks(wbout).Worksheets(sheetout).Range("A" & i)
    End If
End With

The third line contains an unknown variable : i.

You need to define it to contain the number of the line to which you're copying. For example, if you want to copy to the first available line, try this : 

Set wsOut = Workbooks(wbout).Worksheets(sheetout)
With Worksheets(sheetin).Cells(iRow, 2)
    If .Value = "####*" Then
       i = wsOut.Cells(wsOut.Rows.Count, 1).End(xlUp).Row + 1
       .Copy Destination:=wsOut.Range("A" & i)
    End If
End With

Upvotes: 2

Related Questions