Hallo zusammen,
ich habe folgendes Problem:
Ich habe ein Sheet und auf diesem Sheet sind 6 identische Vorlagen untereinander (also Seite 1-6). Nun möchte ich per Makro ab einer bestimmten Zeile immer 7 Spalten und 10 Zeilen einlesen.
Also beispielsweise ab C18, 7 Spalten nach rechts und 10 Zeilen nach unten einlesen. Das klappt beim ersten Blatt auch wunderbar. Nun muss ich aber die restlichen 5 Seiten auch einlesen können...
Sub CommandButton1_Click()
Initial
'On Error Resume Next
poDialog.Execute
End Sub
Sub CommandButton2_Click()
'-------------check for playing around---------------
Dim byWert As Byte
byWert = MsgBox("If you want to create PO Number, push ok button!! Make sure that PO is completed!", vbOKCancel, "Confirmation")
If byWert = 2 Then
GoTo marke
End If
'-------------check for cost code and cost center---------------
If Range("H13").Value = "" Or Range("H14").Value = "" Then
MsgBox ("Please include Cost Code and Cost Center!")
GoTo marke
End If
'==================================COPY DATA========================================
Dim ponr, po_year
Dim orderdate, po_nr, cost_acc, cost_cen, qt_nr, supplier1, c_attention1, c_tel1, c_fax1, c_email1
Dim ship_to_customer, c_attention2, c_adress, o_name, o_tel, o_fax, o_email, counter, counter1
Dim payment_terms, delivery_terms, delivery_time, total_price, curr, Items(20, 20), freight, taxed, nontaxed, tax
Windows("PO_Tool_Optogan_Kopie.xlsm").Activate
Sheets("PO Master").Select
If Not Range("H7").Value = "" Then
MsgBox ("This number already exists!")
GoTo marke
End If
Sheets("PO Master").Select
'-------------terms---------------
orderdate = Range("H8").Value
po_nr = Range("H7").Value
cost_acc = Range("H13").Value
cost_cen = Range("H14").Value
qt_nr = Range("H9").Value
'-------------contact person Optogan---------------
o_name = Range("C41").Value
'o_tel = Range("C42").Value
'o_fax = Range("C43").Value
o_email = Range("C44").Value
'-------------supplier---------------
supplier1 = Range("C7").Value
c_adress = Range("C9").Value + ", " + Range("C10").Value + ", " + Range("C13").Value
c_attention1 = Range("C8").Value
c_tel1 = Range("C11").Value
c_fax1 = Range("C12").Value
'-------------conditions---------------
payment_terms = Range("H12").Value
delivery_terms = Range("H10").Value
delivery_time = Range("H11").Value
'-------------currency---------------
curr = Range("G17").Value
'curr = Right(curr, Len(curr) - 12)
'-------------total price---------------
total_price = Range("I251").Value
'-------------copy items of sheet 1---------------
Range("C18").Select
For o = 0 To 9
Items(o, 0) = Range("C18").Offset(o, 0).Value
Items(o, 1) = Range("D18").Offset(o, 0).Value
Items(o, 2) = Range("E18").Offset(o, 0).Value
Items(o, 3) = Range("F18").Offset(o, 0).Value
Items(o, 4) = Range("G18").Offset(o, 0).Value
Items(o, 5) = Range("H18").Offset(o, 0).Value
Items(o, 6) = Range("I18").Offset(o, 0).Value
Next
'-------------check if file is open---------------
If IsFileOpen("O:\PO\2_PO_MI\PO#.xls") Then
MsgBox "Somebody is using the PO# file. Please check in Folder O:\PO\O:\PO\2_PO_MI\PO#.xls or try later!"
GoTo marke
End If
If IsFileOpen("O:\PO\PO_Database.xlsx") Then
MsgBox "Somebody is using the PO_Database file. Please check in Folder O:\PO\PO_Database.xlsx or try later!"
GoTo marke
End If
Workbooks.Open Filename:="O:\PO\2_PO_MI\PO#.xls"
Sheets("2011").Select
Range("a10").Select
Dim currentmonth, nextponr
currentmonth = Right(Date, 7)
currentmonth = Right(currentmonth, 4) & "_" & Left(currentmonth, 2)
While Not currentmonth = Left(Selection.Value, 7) 'red
Selection.Offset(0, 1).Select
Wend
While Selection.Interior.Color = 255 'red
Selection.Offset(1, 0).Select
Wend
Selection.Interior.Color = 255
nextponr = Selection.Value
ActiveWorkbook.Close SaveChanges:=True
'=========================================CREATE PO NR========================================
'-------------check if file is open---------------
If IsFileOpen("O:\PO\PO_Database.xlsx") Then
MsgBox "Somebody is using the PO_Database file. Please check in Folder O:\PO\PO_Database.xlsx or try later!"
GoTo marke
End If
Workbooks.Open Filename:="O:\PO\PO_Database.xlsx"
Sheets("PO database").Select
Range("A7").Select
Dim pocheck, pobasic
While Not IsEmpty(Selection.Value)
Selection.Offset(1, 0).Select
Wend
ponr = Selection.Offset(-1, 0).Value
pocheck = Left(ponr, 7)
ponr = Right(ponr, Len(ponr) - 8)
ponr = ponr + 1
pobasic = Right(Date, 7)
pobasic = Right(pobasic, 4) & "_" & Left(pobasic, 2)
'-------------beginning of new month---------------
If Not pobasic = pocheck Then
ponr = 1
End If
ponr = pobasic & "_" & ponr
If Not ponr = nextponr Then
MsgBox ("there is discrepance between new and old po system!")
ponr = nextponr
End If
'=========================================STORE DATA FROM DASHBOARD========================================
Windows("PO_Tool_Optogan_Kopie.xlsm").Activate
Sheets("PO Master").Select
Range("H7").Value = ponr
Windows("PO_Database.xlsx").Activate
Sheets("po database").Select
Selection.Value = ponr
'-------------1_order date---------------
Selection.Offset(0, 1).Value = orderdate
'-------------2_quotation number---------------
Selection.Offset(0, 2).Value = qt_nr
'-------------3_cost code---------------
Selection.Offset(0, 3).Value = cost_acc
'-------------4_cost center---------------
Selection.Offset(0, 4).Value = cost_cen
'-------------5_supplier---------------
Selection.Offset(0, 5).Value = supplier1
'-------------6_customer adress---------------
Selection.Offset(0, 6).Value = c_adress
'-------------7_customer attention---------------
Selection.Offset(0, 7).Value = c_attention1
'-------------8_customer tel---------------
Selection.Offset(0, 8).Value = c_tel1
'-------------9_customer fax---------------
Selection.Offset(0, 9).Value = c_fax1
'-------------10_OG name---------------
Selection.Offset(0, 10).Value = o_name
'-------------11_OG email---------------
Selection.Offset(0, 11).Value = o_email
'-------------12_payment terms---------------
Selection.Offset(0, 12).Value = payment_terms
'-------------13_delivery terms---------------
Selection.Offset(0, 13).Value = delivery_terms
'-------------14_delivery time---------------
Selection.Offset(0, 14).Value = delivery_time
'-------------15_total price---------------
Selection.Offset(0, 15).Value = total_price
'-------------16_currency---------------
Selection.Offset(0, 16).Value = curr
'=========================================STORE PRODUCTS OF DASHBOARD========================================
'-------------1_sheet---------------
counter = 0
For o = 0 To 9
For i = 0 To 6
counter = counter + 1
Selection.Offset(0, 17 + counter).Value = Items(o, i)
Next
Next
'-------------save and close---------------
ActiveWorkbook.Close SaveChanges:=True
Windows("PO_Tool_Optogan_Kopie.xlsm").Activate
Sheets("po master").Select
marke:
End Sub
Sub DruckenSpeichern()
Dim poname
Sheets("PO Master").Select
poname = Range("L3").Value & "_" & Range("C35").Value
If Range("L3").Value = "" Then
MsgBox ("Please, create po number!")
GoTo marke
End If
'-------------save file---------------
ActiveWorkbook.SaveAs Filename:= _
"O:\PO\3_POP\" + poname + ".xls", FileFormat:=xlOpenXMLWorkbook _
, CreateBackup:=False
ActiveWorkbook.Close
marke:
End Sub
Public Function IsFileOpen(ByRef Path As String) As Boolean
Dim FileNr As Integer
Dim ErrorNr As Long
'Datei testweise öffnen:
On Error Resume Next
FileNr = FreeFile
Open Path For Input Lock Write As #FileNr
ErrorNr = Err.Number
Close #FileNr
On Error GoTo 0
'Ggf. Fehler verarbeiten:
Select Case ErrorNr
Case 0 'kein Fehler:
'NOP
Case 70 'Permission denied':
IsFileOpen = True
Case Else 'sonstiger Fehler:
Err.Raise ErrorNr
End Select
End Function
wie kann ich bestimmte Bereiche einlesen und dann auch alle wieder ausgeben? Gesagt sei auch, dass alle Zeilen in einer neuen Datei in eine EINZIGE Zeile nach rechts geschrieben werden?
Bei Fragen könnt ihr euch nochmal gerne an mich wenden.
Grüße,
hans
|