Copy Rang from Excelfile IF....

**Ruseju** · 10-17-2016, 05:41 AM

Hello,

I try to build an userform, that copy specific data from other excel files (all the same layout). But the "Copy - Paste" should only run if some conditions are true.

The Userform is disigned as a pultipage with 3 Pages (see attachment). The First page is a filpicker, only picked files should be searched. The 2nd and 3rd are Checkboxes ( ca 8 ) if a checkbox is true, the macro should copy the data if the value in the Excel file is the same. e.g. If checkboxCu = true Copy Range(F45) if Range(F45).value =Cu (or similar ? ) This should work for each box and combined boxes. The Makro should than run all selcted files. Ckeck if the cells have the wanted values and copy an other area in my "combined data" excel file. I think i need a bit help because i am not that god in VBA. This is my code so far :

'Ordnervars

Public ordner As Variant
Public datein





Private Sub BtnCancel_Click()

Me.Hide

End Sub

Private Sub BtnMatWahl_Click()

Set dat = Application.FileDialog(msoFileDialogFilePicker) ' Dialogfenster Materialien Wählen wählen

With dat
   .Title = "Welche materialien wollen sie auswählen?"
   .InitialFileName = "C\\" 'Pfad wählen
nochmal: 'sprungmarke s.u.
    If .Show = -1 Then
    ordner = .SelectedItems(1)
    Else:
        If MsgBox(" Material wählen ! " & vbCrLf & "Nochmal ?", vbYesNo) = vbYes Then
        GoTo nochmal 'sprung s.o.
        Else:
        GoTo raus 'sprung siehe unten
        End If
    End If
End With

raus:

End Sub




Private Sub BtnSearch_Click()

Dim Ac As Worksheet
Set Ac = ActiveSheet

Dim wb As Workbook
Dim ExcelFile As Object

Dim fso As Object
Dim datein As Object

Set fso = CreateObject("Scripting.filesystemobject")
Set datein = fso.getfolder(ordner)

Dim CopyRange As Range
Dim cell As Range
Dim r As Long
Dim c As Integer

For Each ExcelFile In datein.Files
  If ExcelFile.Name Like "*.xlsx" And CheckBoxCu.Value = True Then
    Set wb = Workbooks.Open(ExcelFile.Path)
    If wb.Worksheets("Messwerte").Range("F45") = Cu Then
        Set CopyRange = wb.Sheets("Messwerte").Range("A1,B45,C3:C12")
        r = Ac.Cells(Rows.Count, 2).End(xlUp).Row + 1
     
        c = 2
        For Each cc In CopyRange
            Ac.Cells(r, c).Value = cc.Value
            c = c + 1
            wb.Close False
            Next cc
      
End If
    End If
    
     Next
       

End Sub





Private Sub CheckBoxAlles2_Click()
 
If CheckBoxAlles2 = True Then
 
CheckBoxCar = True
CheckBoxBuilding = True
CheckBoxAirpl = True
CheckBoxElec = True

Else

CheckBoxCar = False
CheckBoxBuilding = False
CheckBoxAirpl = False
CheckBoxElec = False

End If
End Sub

Private Sub CheckBoxAlles1_Click()

If CheckBoxAlles1 = True Then

CheckBoxCu = True
CheckBoxFe = True
CheckBoxMg = True
CheckBoxAl = True
CheckBoxTi = True

Else

CheckBoxCu = False
CheckBoxFe = False
CheckBoxMg = False
CheckBoxAl = False
CheckBoxTi = False

End If

End Sub


Private Sub CheckBoxSodium_Click()

End Sub

Private Sub UserForm_Initialize()
 
 
 MultiPage1.Pages(1).ScrollBars = _
 fmScrollBarsVertical
 
 MultiPage1.Pages(1).KeepScrollBarsVisible = _
 fmScrollBarsVertical
 
 MultiPage1.Pages(1).ScrollHeight = _
 2 * MultiPage1.Height
 
 MultiPage1.Pages(1).ScrollTop = 0
 
 End Sub
 
Private Sub UserForm_Activate()
 
Dim TopOffset As Integer
Dim LeftOffset As Integer


     
    TopOffset = (Application.UsableHeight / 2) - (Me.Height / 2)
    LeftOffset = (Application.UsableWidth / 2) - (Me.Width / 2)
     
    Me.Top = Application.Top + TopOffset
    Me.Left = Application.Left + LeftOffset
    
End Sub

Right now it used check, whether one checkbox is true and ckeck the cell for it plus there a " path not found error in the line " Set datein = fso.getfolder(ordner) "

Thank you for your help !