rijen slecteren

[frankli]

Hoi,

Ik heb twee excel bestanden, in bestand1 zijn er twee tabbladen: Bron data1, Raw data.
In bestand2 zijn er ook twee tabbladen: Bron data, Draaitabel.
Nu wil ik de rijen met inhoud in bestand1 tabblad- "Bron data1" via VBA code selecteren, maar alle rijen met 0 niet selecteren.
Daarna wil ik de geselecteerde rijen kopiëren en plakken in Bestand2 tabblad- "Bron data".
Maar er zijn soms meer rijen in Bestand 1 dan in Bestand2, dus voordat de geselecteerde rijen geplakt worden in Bestand1, moet er nog rijen ingevoegd worden totdat er evenveel rijen zijn, bijvoorbeed in dit voorbeeld zijn de rijen 2-10, maar in Bestand2 zijn de rijen 2-7, dus in Bestand2 moet er nog 3 rijen ingevoegd worden. Maar ik kan niet de rijen toevoegen vanaf de laatste rij, anders gaat de draaitabel mis.

Hoe kan ik een VBA code schrijven om dit te doen?


Groetjes,
Frank

 

[frankli]

ik heb nu zelf een code gemaakt, kan iemand mijn code vereenvoudigen?



Sub Debiteurenlijst()

Application.ScreenUpdating = False

Dim numberbron1 As Integer
Dim numberbron2 As Integer
Dim numberinsert As Integer

' Bron data 0 rijen verwijderen

Workbooks.Open "F:\macro\bestand1.xls"
Sheets("Bron data1").Select
Range("A2").Select
Do Until Selection.Value = "Eind"
If Selection.Value = 0 Then
Selection.EntireRow.Delete
Else
Selection.Offset(1, 0).Select
End If
Loop
Application.ScreenUpdating = True

Range("A2").Select
Range(Selection, Selection.End(xlDown)).EntireRow.Select
numberbron1 = Selection.Rows.Count
MsgBox numberbron1

' Bestand 2 rijen invoegen of verwijderen

Workbooks.Open "F:\macro\bestand2.xls"
Range("D2").Select
Range(Selection, Selection.End(xlDown)).EntireRow.Select
numberbron2 = Selection.Rows.Count
MsgBox numberbron2

If numberbron2 < numberbron1 Then

numberinsert = numberbron1 - numberbron2 - 1
ActiveSheet.Range("3:" & CStr(3 + numberinsert)).EntireRow.Insert

'Terug naar Bestand 1 kopieren
Windows("Bestand1.xls").Activate
Sheets("Bron data1").Select
Range("2:" & CStr(numberbron1)).EntireRow.Select
Selection.Copy

'Terug naar Bestand2 Plakken
Windows("Bestand2.xls").Activate
Sheets("Bron data").Select
Range("A2").Select
Selection.PasteSpecial xlPasteValues
Application.CutCopyMode = False

End If

Application.ScreenUpdating = True


End Sub

 

[Wigi]

U weet dat .Select en .Activate overbodig zijn?

 

[snb]

sub tst()
  Workbooks.Open "F:\macro\bestand2.xls"
  With Workbooks.Add("F:\macro\bestand1.xls")
     with .Sheets("Bron data1").range("A1").currentregion
       .autofilter 1,"<>0"
       .specialcells(xlcelltypevisible).copy Workbooks("bestand2").cells(rows.count,1).end(xlup).offset(1)
     end with
      .close false
  end with 
  Workbooks("bestand2").close true
End Sub

 

[frankli]

Hoi SNB, Thanks for your reply.
When I run your code, it shows error in this line:

.SpecialCells(xlCellTypeVisible).Copy Workbooks("Bestand2").Cells(Rows.Count, 1).Offset(1)

 

[snb]

Waardoor komt dat denk je ?

 

[Wigi]

Frankli

- dit is een Nederlandstalig forum
- End(xlUp) ontbreekt in de code van Snb

Wigi

 

[frankli]

Sorry, ik ben een beginner, ik weet niet hoe ik het kan aanpassen, kan je de juiste code schrijven?

 

[Wigi]

.SpecialCells(xlCellTypeVisible).Copy Workbooks("Bestand2").Cells(Rows.Count, 1)[B].end(xlUp)[/B].Offset(1)