Microsoft Office Forums - View Single Post - VBA: Creating new Worksheets from two different Workbooks

macropod · 09-07-2012, 09:30 PM

Hi johanna,

In your 'modul1', try replacing the three 'If strFile <> CStr(False) Then' blocks with one block coded as:

Code:

If strFile <> CStr(False) Then
  Set objWB = Workbooks.Open(strFile)
  For Each objSh In ThisWorkbook.Worksheets
    If objSh.Name <> "Übersicht" Then
      If SheetExist(objSh.Name, objWB) = False Then
        Set objNewSh = ThisWorkbook.Sheets.Add
        objNewSh.Name = Split(objWB.Name, ".")(0)
      End If
      objSh.Range("g7") = objWB.Sheets(objSh.Name).Range("g7").Value
      objSh.Range("C12:I28") = objWB.Sheets(objSh.Name).Range("C12:I28").Value
      objSh.Range("b7") = objWB.Sheets(objSh.Name).Range("b7").Value
    End If
  Next
  objWB.Close False
End If

In your 'modul2', try replacing the two 'If strFile <> CStr(False) Then' blocks with one block coded as:

Code:

If strFile <> CStr(False) Then
  Set objWB = Workbooks.Open(strFile)
  For Each objSh In ThisWorkbook.Worksheets
    If objSh.Name <> "Übersicht" Then
      If SheetExist(objSh.Name, objWB) = False Then
        Set objNewSh = ThisWorkbook.Sheets.Add
        objNewSh.Name = Split(objWB.Name, ".")(0)
      End If
      objSh.Range("p7") = objWB.Sheets(objSh.Name).Range("g7").Value
      objSh.Range("L12:R28") = objWB.Sheets(objSh.Name).Range("C12:I28").Value
    End If
  Next
  objWB.Close False
End If